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<%PERL_INIT> 



my ©types = { 

{ 'code' =>'Amex' , ' name ' -> 'American Express' }, 
{ ' code '=> 'Visa' , ' name ' => 'Visa ' }, 

); 

return ( ©types ) ; 
</%PERL_INIT> 
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<%doc> 

Passing a Credit Card number and a Credit Card type 
Check the validity of a card. 
Return 0 for bad card, 

1 for a good card. 
System cleans the number, does various logical checks 

and checks the cards actual 1 validity algorythm. 
I've only tested on one visa number. 
</%doc> 
<%init> 
my $ result ; 
my $offset; 

my $checkBit = substr ( $CCNumber , 0, 2); 

#remove noise 

$CCNumber =~ s/[\s\-]//g; 

return 0 if $CCNumber !~ /^\d+$/; 

my $CCLength = length $CCNumber; 

if (lc ($CCCardType) eq "visa") { 

return 0 unless $CCLength 13 or $CCLength == 16; 

return 0 unless $checkBit /M\d$/; 

$offset = 1; 
} elsif ( 1 c ( $CCCardType ) eq "amex" ) { 

return 0 unless $CCLength == 15; 

return 0 unless $checkBit == 34 or $checkBit == 37; 
"'Z $offset = 0; 

^} elsif {lc ($CCCardType) eq "mastercard") { 
■J return 0 unless $CCLength == 16; 
£~ return 0 unless $checkBit =~ /^5\d$/; 
'JZ $offset = 1; 

"--4 elsif ( 1 c ( $CCCardType ) eq "discovery") { 
if\ return 0 unless $CCLength == 16; 
]H return 0 unless $checkBit == 60; 
-"=J $offset = 1; 
ill} else { 

return 0; 

: } 

I^oreach my $i (0 { $CCLength-l ) ) { 

Mj my $bit = substr { $CCNumber, $i, 1); 

:r. #determine if we should double the bit 

fU my $double = ($i+$offset) % 2; 

111 my $bitSum = $bit + ($double * $bit) ; 

$bitSum = substr {$bitSum,0, 1) + substr ($bitSum, 1, 1) if $bitSum >= 10; 
;ss? $result += $bitSum; 

return ! ($result % 10); 

</%init> 

<%args> 

$CCNumber 

$CCCardType 

</%args> 



<%doc> 

Executes direct submission of a payment to CyberCash CashRegister 

Args : 
% sender 

- what are the keys of 
%cc 

- what are the keys of 
%order 

- what are the keys of 

Returns : 
\%POP 

- what are the keys of 
\%tokenList 

- what are the keys of 



this hash? 
this hash? 
this hash? 

this hash? 
this hash? 



Example : 

mc„comp (' /shared/credit/charge' , sender=>\%sender , cc=>\%sender , order=>\%order ) 

</%doc> 

<%args> 

% sender 

%cc 
border 
5 2=/%args> 
^Lk%init> 

•dise CyberC : : CCMckLib3_2 ; 
^iise CyberC : : CCMckDirectLib3_2 ; 
;Hise CyberC : : CCMckErrno3_2 ; 

\my (%POP, %tokenList ); 

\=M Initialize the Global Configuration array in CCMckLib3_2 

\f# JW - change setting of $ConfigFile variable based on where it will eventually 
reside 

; my $Conf igFile= ' /home/www/servers/lucidity/app/lucidityinc-83 /mck-cgi/conf /merch 
^=%nt„conf ' ; 

Hjay $status = CyberC: :CCMckLib3_2 :: InitConfig( $ConfigFile) ; 
lUf ($status != 0) { 

ry $POP{status} = MCKGetErrorMessage ( $status) ; 
]^ return (\%POP, \%tokenList) ; 

""CyberC: :CCMckLib3_2 : :CCDebug { "Entering $0\n" ) ; 

my $cybercashld = $CyberC : :CCMckLib3_2 : :Conf ig{ B CYBERCASH_ID" } ; 
my $hashSecret = $CyberC : : CCMckLib3_2 : :Conf ig{ "HASH_SECRET" } ; 
my $ccpsHost = $CyberC : : CCMckLib3_2 : : Conf ig{ " CCPS_HOST" } ; 
my $templateDir = $CyberC : : CCMckLib3_2 : : Conf ig{ '*TEMPLATE_DIR" } ; 
my $redirectURL = $CyberC : : CCMckLib3_2 : : Conf ig{ "REDIRECTJJRL " } ; 

# A Note about message fields in paymentNVList . 

# paymentNVList holds message parameters 

# that will be passed to the Cash Register 
# 

# These parameters are broken into three blocks according to 

# a prefix in the argument field name. 
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# 

# prefix use 
# 

# mo. — data driving the Cash Register 

# t this include Payment data and some operational options 

# cpi. — info about the Customer's "Payment Instrument: (credit /check 

# mf . — anything additional you want to pass on 

# to the Fulfillment Center 



my %paymentNVList ; 

$paymentNVList{ 'mo. cyber cash- id' } = $cybercashld; 

$paymentNVList{ 'mo. version ' } = $CyberC : : CCMckLib3_2 : :MCKversion; #CCPS message 
version 

# The MO and CPI blocks are not signed, since 

# the message will be encrypted 



- mc_comp ( ' /shared/utils/unique__id' ) ; 
= $order{order id} ; 



$paymentNVList { 'mo, signed-cpi ' } = "no"; 

# Load payment instrument info from form 

if( ! $order{order_id} ){ 

$paymentNVList { 'mo. order- id' } 
} else { 

m $paymentNVList{ 'mo. order-id' } 

\£paymentNVList{ 'mo. price' } 
JjpaymentNVList { ' cpi . card-number ' } 
;h?paymentNVList{ ' cpi . card-exp' } 
'•^b_year' } ; 

; f$paymentNVList { ' cpi . card-name ' } 
I Lt_name ' } ; 

l :^paymentNVList{ ' cpi . card-address ' } 
(T$paymentNVList{ ' cpi . card-city ' } 

"$paymentNVList { ' cpi . card-state' } 
I $paymentNVList{ 'cpi .card-zip' } 
I«£$paymentNVList{ 'cpi .card-country' } 



= ' USD $order{ 'amount '} ; 
= $cc { ' card_number ' } ; 

= $cc { ' card_exp_month '}.'/'. $cc { ' card_ex 

= $ sender {' firs t_name' }. ' ' . $sender { ' las 

= $sender {' street '}. ' ' . $sender {apt } ; 
= $sender { ' city ' } ; 
- $sender {' state '} ; 
= $ sender {' zip '} ; 
= $ sender {' country '} ; 



This is a CREDIT CARD payment 
Ilk DON'T TOUCH THIS 1 This is the CR script that will process your payment 
Ilfny $script = "directcardpayment . cgi " ; 

^3 ########################### 

I -J # No signatures required to talk to the Cash Register 

# NO SSL required to talk to the Cash Register either. . . 

# Since the whole thing is encrypted, crooks can't mess with it 

# and can't read it either! 
########################### 

# merchant -id gets added to the URL by the connection routine. 

# Don't add it here... 



my $paymentURL = "$ccpsHost$script " ; 

# At this point, all of the data that needs to go into the Payment message 

# should have been collected: So, we can call the Cash Register 

my ($POPref, $tokenListref ) = CyberC : :CCMckDirectLib3_2 : : doDirect Payment { $payme 
ntURL, \%paymentNVList) ; 
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%POP = %$POPref; 

%tokenList = %$tokenListref ; 

my $POPstr = $tokenList { ' POP' } ; 

if ($POP{ 'pop. status ' } =~ / A success-duplicate/ ) { 

#add a message to the template 

$tokenList{ 'DUPLICATE_MSG' } 

= "<p>Please note that this order is a duplicate of one complete 
d previous ly</p>\n" ; 
} 

else { 

$tokenList{ ' DUPLICATE_MSG' } = " "; # put in a blank to ensure substituti 

on 

} 

CyberC: :CCMckLib3_2 : rCCDebug ( "Exiting $0\n" ) ; 
return (\%POP, \%tokenList) ; 



<%PERL_DOC> 

Component to encapsulate a call to app server to charge credit card. 
Should return: 

whether charge was accepted/declined 

information about the order 

any error information generated 

Which of the arguments are necessary? 



</%PERL_DOC> 
<%PERL_ARGS> 
$ queue =>0 
$order_id=>' ' 
$amount=>' 2001 . 00 ' 

$rcv_email=> ' jwintert@optonline . net ' 
$rcv_f ir st _name=> 'Jennifer ' 
$rcv_last__name=> 'Winter ton' 
$snd_f irs t_name=> ' Jason ' 
$snd_last_name=> ' Taylor ' 
$snd_email=> ' j smith© j smith .com' 
$card_type=> ' visa' 
$card_number=> ' 4111111111111111 ' 
$card_exp_month=> ' 12 ' 
$card_exp_year=> ' 04 ' 
$street=> ' 126-128 Church Street' 
|2$apt=>' ' 

"Scity=>'San Francisco' 
*MSstate=>'CA' 
■y?zip_code=> ' 94114-1111 ' 
f$ country => 'USA' 
*^area_code=> ' ' 

phone => ' ' 
|ffc/%PERL_ARGS> 
;lk%PERL_INIT> 

ijf Logically split data 



my $receiver„data 



{ 



}; 



' email ' 


=> 


$rcv_email, 


' f irst_name' 


=> 


$rcv_f irst_name 


' last_name' 


-> 


$rcv_last„name , 


$sender_data = { 






' f irst_name' 


= > 


$snd_f irst_name 


' last_name' 


=> 


$snd_last_name , 


' email ' 


= > 


$snd_email / 


$cc_data = { 






' card_type ' 


= > 


$card_type, 


' card__number ' 


= > 


$card_number , 


' card_exp_month 


-> 


$card_exp_month 


' card_exp_year ' 


-> 


$card_exp_year , 


' street ' 


-> 


$street, 


'apt' 


-> 


$apt, 


' city' 


-> 


Scity, 


' state' 


-> 


$state, 


' zip_code ' 


-> 


$zip__code, 


' country' 


-> 


$ country, 


' area_code ' 


-> 


$area_code, 



LQ 



'phone' => $phone, 

}; 

my $order_data = { 

'order_id' => $order_id, 

'amount' => $ amount, 

}; 



# Check for mandatory fields # 

# Insert error checking code here 

# Check for correct formatting of data # 

if( $cc_data->{ ' card_exp_year ' } =~ / A \d{3,4}$/ ) { 
$cc_data->{'card_exp_year'} =~ s/ ( . * ) ( \d\d) $/$2/ ; 

} 

# Write information to database # 

# mc_comp{ ' /api/record_data/writeSenderData' , data=>$sender_data ); 

# mc_comp( ' /api/record_data/writeRecieverData' , data=>$receiver_data ); 

# mc_comp( ' /api/record_data/writeCCData' , data=>$cc_data ); 

3 Call to CyberCash module to charge # 



gay { $POPref , $tokenListref ) = mc_comp ( ' /lucidity/ app/ secure/credit_auth ' , send 
= ^ r_da t a = > $ s ender__da t a , 

"^1 cc_data=>$cc_data, order_data=>$order_data } ; 

:i|ay %POP = %$POPref; 

*==iay %tokenList = %$tokenListref ; 

" # Place returned information in data structure # 

; my %result = { 

1^ 'status' => $POP{ 'pop. status '} , 

i\\ 'error' => { 

171 'error„code' => 

IU 'error_message' => '', 

'order' => { 
^ ' order_no ' => ' ' , 

O ' order_amount ' -> ' ' , 

}, 

}; 

# Based on return codes, take some actions # 

if( $result{ 'status' } =~ /failure-hard | failure-q-or-cancel | failure-q-or-discard| 
failure-swversion/ ) { 

# queue the transaction 

$result {'status' } = 'queued'; 

} 

# Record the transaction data # 

# Get the transaction data out of the return values here 
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# mc_comp ( ; /api/record_data/writeTransactionData' , data=>%transaction_data ); 



#return{ \%result ); 
return (\%POP); 

</%PERL_INIT> 
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<%perl_doc> 

this component is used for a direct submission of a payment to CyberCash CashReg 
ister 

</%perl_doc> 

<%args> 

$order_id=> ' ' 

$amount=>0 

$f irst_name 

$last_name 

$ c a r d_numbe r 

$card_exp_month 

$ card_exp_y ear 

$street=> ' ' 
: $apt=>" 

$city=> ' ' 

$state=>' ' 

$zip_code 
' $ count ry=> ' ' 

</%args> 

<%once> 

use CyberC: :CCMckLib3_2; 

use CyberC: :CCMckDirectLib3_2; 

use CyberC : : CCMckErrno3_2 ; 

my (%sender, %cc, %order, %POP, %tokenList ); 
1% Initialize the Global Configuration array in CCMckLib3_2 

^3 - change setting of $ConfigFile variable based on where it will eventually 
'Mreside and confirm giftcat names 
""~hy $ConfigFile; 

gLf ( $ARGS{gif teat} eq ' charities ') { 

$ConfigFile = ' /home/www/servers/lucidity/app/lucidityinc-83/mck-cgi/con 
,:: jE/merchant_conf ' ; 

iff 

i^lsif {$ARGS{ giftcat} eq 'giftcert'H 

■;f $ConfigFile = ' /home/www/servers/lucidity/app/lucidityinc-83/mck-cgi/con 

li£/shine„conf ' ; 
\' ) 

I my $status = CyberC: :CCMckLib3_2 :: InitConfig{ $ConfigFile) ; 

^yc/%once> 
= 5 ~*c%init> 

sMLf ($status != 0} { 

III $POP{status} = MCKGetErrorMessage($status) ; 
;i return (\%POP, \%tokenList) ; 

CyberC: : CCMckLib3_2 : : CCDebug ( " Entering $0\n") ; 

my $cybercashld = $CyberC : : CCMckLib3_2 : : Conf ig{ "CYBERCASH_ID" } ; 
my $hashSecret = $CyberC : :CCMckLib3_2 : :Conf ig{ "HASH„SECRET" } ; 
my $ccpsHost = $CyberC : : CCMckLib3_2 : : Conf ig{ "CCPS_H0ST M } ; 
my $templateDir = $CyberC : : CCMckLib3_2 : : Conf ig{ "TEMPLATE_DIR" } ; 
my $redirectURL = $CyberC : : CCMckLib3_2 : : Conf ig{ "REDIRECTJJRL" } ; 

# A Note about message fields in paymentNVList. 

# paymentNVList holds message parameters 

# that will be passed to the Cash Register 
# 

# These parameters are broken into three blocks according to 

# a prefix in the argument field name. 
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# 

# prefix use 
# 

# mo. — data driving the Cash Register 

# this include Payment data and some operational options 

# cpi . — info about the Customer's "Payment Instrument: (credit /check 

) 

# mf . — anything additional you want to pass on 

# to the Fulfillment Center 

my %paymentNVList ; 

$paymentNVList { 'mo . cybercash-id' } = $cybercashld; 

$paymentNVList{ 'mo. version ' } = $CyberC : :CCMckLib3__2 : rMCKversion; #CCPS message 
version 

# The MO and CPI blocks are not signed, since 

# the message will be encrypted 

$paymentWList { 'mo . signed-cpi ' } = "no"; 



# load payment instrument info from form 

if( i defined ($order„id) || ! $order_id ){ 

$paymentNVList { 'mo . order-id' } = mc_comp ( ' /shared/utils/unique_id' ) ; 
§3 else { 

"~ $paymentWList { 'mo . order-id' } = $order__id; 



j^paymentNVList { 'mo .price ' } 
'H?paymentWList { ' cpi . card-number ' } 
'S$paymentNVList{ ' cpi . card-exp' } 
fjSpaymentNVList { ' cpi . card-name ' } 



■LppaymentNVList { 
s > ~J? paymen tNVL i s t { 
IJ^paymentNVList { 



cpi . card-address ' } 
cpi . card-city' } 
cpi . card-state ' } 
$paymentNVList { ' cpi . card- zip ' } 
$paymentNVList { ' cpi . card-country ' } 



'USD ' . $ amount ; 
$ card_numbe r ; 

$card_exp_month. ' / ' . $card_exp_year ; 

$first_name. ' ' . $last__name; 

$apt ? $street.' ' . $apt : $street; 

$city; 

$state; 

$zip_code; 

$ count ry; 



Hp This is a CREDIT CARD payment 

Iff DON'T TOUCH THIS! This is the CR script that will process your payment 
^Mny $script - "directcardpayment . cgi " ; 

;%iy $paymentURL = " $ccpsHost$script " ; 

;3At this point, all of the data that needs to go into the Payment message 
# should have been collected: So, we can call the Cash Register 

my ($POPref, $tokenListref ) = CyberC : :CCMckDirectLib3„2 : rdoDirectPayment ( $payme 
ntURL, \%paymentNVList) ; 

CyberC: :CCMckLib3_2 : : CCDebug ( "Exiting $0\n") ; 

return ($POPref ) ; 
</%init> 
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<%init> 

my $ cookie; 

if ($ARGS{name} & $ARGS{value} ) { 

# Set cookie 

$cookie = new CGI:: Cookie 
( 

-name => $ARGS {name} , 
-value => $ARGS {value } , 
-expires => $ARGS { expires } , 
-domain => $ARGS { domain } , 
-path => $ARGS{path}, 
) ; 

$r->header_out { ' Set-Cookie' => $cookie) ; 

} 

else { 

# Get cookie 

return fetch CGI: : Cookie ($r->header_in (' Cookie ' ) ) ; 

} 

</%init> 
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<%perl_doc> 

this component is used for a direct submission of a payment to CyberCash CashReg 
ister 

<%/perl_doc> 
<%args> 
<%PERL_ARGS> 
$sender_data=> ' ' 
$cc_data=> ' ' 
$order_data=> ' ' 
</%PERL_ARGS> 
<%init> 

use CyberC: : CCMckLib3_2 qw ( $MCKversion %Config URLdecodeForm 
InitConfig CCError CCDebug CCDebug2 GetQuery 
PrintTemplate LoadBlockFromQuery 
BuildSignature } ; 

use CyberC : :CCMckDirectLib3_2 qw (doDirect Payment ) ; 

use CyberC: :CCMckErrno3_2 qw(MCKGetErrorMessage $E„NoErr 
$E_Fail_Notif 
$ E„Payment JFai led 
$E_No_Receipt 

$E_MO_Signature 

$E_MF_Signature 

$E_No_Template 

■Mny (%POP, %tokenList) ; 

f# Initialize the Global Configuration array in CCMckLib3_2 

\pk JW - change setting of $ConfigFile variable based on where it will eventually 
fireside 

I nny $Conf igFile= ' /www/ servers /lucidity/app/test-mck/mck-cgi/conf /merchant_conf ' 
lliny $status = &InitConf ig ($Conf igFile) ; 

IfiLf ($status != 0) { 

$POP{status} = &MCKGetErrorMessage($status) ; 
return (\%POP / \%tokenList> ; 

IJ^CCDebug ( "Entering $0\n" ) ; 

jyny $cybercashld = $Conf ig{ "CYBERCASH_ID" } ; 
]^ay $hashSecret = $Conf ig{ "HASH_SECRET" } ; 
^4ay $ccpsHost = $Config{ , 'CCPS_HOST" } ; 
Ijny $templateDir = $Conf ig{ "TEMPLATE__DIR" } ; 
my $redirectURL = $Conf ig{ "REDIRECT_URL" } ; 



# A Note about message fields in paymentNVList . 

# paymentNVList holds message parameters 

# that will be passed to the Cash Register 
# 

# These parameters are broken into three blocks according to 

# a prefix in the argument field name. 
# 

# prefix use 
# 

# mo. — data driving the Cash Register 

# this include Payment data and some operational options 

# cpi . — info about the Customer's "Payment Instrument: (credit /check 



) 

# mf . — anything additional you want to pass on 

# to the Fulfillment Center 

my %paymentNVList; 

$paymentNVList { 'mo . cybercash-id' } = $cybercashld; 

$paymentNVList{ 'mo. version' } = $MCKversion; #CCPS message version 

# The MO and CPI blocks are not signed, since 

# the message will be encrypted 

$paymentNVList { 'mo . signed-cpi ' } = "no"; 



# load payment instrument info from form 



if( !def ined($order_data->{order_id} ) || ! $order_data->{order_id} ){ 

$paymentNVList { ' mo . order-id' } = mc_comp { ' / shared/ credit_card/uniqueld' ) ; 
} else { 

$paymentNVList{ 'mo. order-id' } = $order_data-> {order_id} ; 

} 



$paymentNVList { 'mo .price ' } 
$paymentNVList { ' cpi . card-number ' } 
$paymentNVList { ; cpi . card-exp ' } 

f 2&ta-> { ' card_exp__year ' } ; 

.'3?paymentNVList{ ' cpi . card-name' } 

^*4r_data->{ ' last_name' } ; 

'^paymentNVList { ' cpi . card-address ' } 

, pa {apt} ; 

j^paymentNVList { ' cpi . card- city' } 
'^paymentNVList { ' cpi . card-state ' } 
| f$paymentNVList { ' cpi . card-zip' } 
,LppaymentNVList{ ' cpi . card-country ' } 



= 'USD $order_data->{ 'amount '} ; 

= $cc_data-> { ' card__number ' } ; 

= $cc_data->{ ' card_exp_month' }.'/'. $cc_d 

= $sender_data->{ ' f irst_name' } . ' ' . $send 

= $sender_data{ ' street ' } . ' ' . $sender_dat 

= $sender_data{ ' city ' } ; 
= $sender_data{ ' state' } ; 
= $sender_data{ ' zip ' } ; 
= $ sender_data { ' country ' } ; 



!p This is a CREDIT CARD payment 

# DON'T TOUCH THIS1 This is the CR script that will process your payment 
I my $script = "directcardpayment . cgi " ; 

iff ########################### 

# No signatures required to talk to the Cash Register 
y-" # NO SSL required to talk to the Cash Register either. . . 

1 4J # Since the whole thing is encrypted, crooks can't mess with it 

• ~*z # and can't read it either! 

■f ########################### 



# merchant -id gets added to the URL by the connection routine. 

# Don't add it here... 



my $paymentURL = " $ccpsHost$script " ; 

#At this point, all of the data that needs to go into the Payment message 
# should have been collected: So, we can call the Cash Register 

my ($POPref, $tokenListref ) = &doDi rect Payment ( $paymentURL, \%paymentNVList) ; 



%POP = %$POPref; 

%tokenList = %$tokenListref ; 

my $POPstr = $tokenList { ' POP ' } ; 
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if ($POP{ 'pop. status ' } =~ /^success-duplicate/ ) { 

#add a message to the template 

$tokenList{ ' DUPLICATE_MSG' } 

= "<p>Please note that this order is a duplicate of one complete 
d previously</p>\n" ; 
} 

else { 

$tokenList{ ' DUPL1CATE_MSG' } = " "; # put in a blank to ensure substituti 

on 
} 

&CCDebug( "Exiting $0\n" ) ; 
return {\%POP / \%tokenList) ; 
<%/init> 
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<%perl_doc> 

ister COmP ° nent iS USed a direct submis sion of a payment to CyberCash CashReg 

</%perl_doc> 

<%args> 

$sender_data=>' ' 
$cc_data=> ' ' 
$order_data=> ' ' 
</%args> 
<%init> 

use CyberC: :CCMckLib3_2; 

use CyberC: :CCMckDirectLib3__2; 

use CyberC: :CCMckErrno3_2; 

my <%sender, %cc, %order, %POP, %tokenList ); 
%sender = %$sender„data; 
%cc - %$cc_data; 
%order = %$order_data; 

# Initialize the Global Configuration array in CCMckLib3__2 

# JW - change setting of $ConfigFile variable based on where it will eventually 
reside * 

my $ConfigFile=Vhome/www/servers/lucidity/app/lucidityinc-83/mck-cgi/conf/merch 
ant_conr ' ; 

my $status = CyberC: :CCMckLib3_2 :: InitConfig{ $ConfigFile) ; 
;3.f {$status '= 0) { 

=y $POP{status} = MCKGetErrorMessage($status) ; 
■U return (\%POP, \%tokenList) ; 

"CyberC: :CCMckLib3_2: : CCDebug ( "Entering $0\n") ; 

••jjiy $cybercashld = $CyberC: :CCMckLib3_2 : : Conf ig{ " CYBERCASH_ID " } * 
**&y $hashSecret = $CyberC : :CCMckLib3„2 : : Conf ig{ "HASH_SECRET" } ; 
sfmy $ccpsHost = $CyberC : : CCMckLib3_2 : :Conf ig{ "CCPS_HOST" } ; 

my $templateDir = $ CyberC : :CCMckLib3_2 : :Conf ig{ "TEMPLATEJIR" } • 
■my $redirectURL = $CyberC : :CCMckLib3_2 : :Conf ig{ "REDIRECT_URL" } ; 

|y # A N °te about message fields in paymentlSiVList . 

U= # paymentlSTVList holds message parameters 

# that will be passed to the Cash Register 

III # 

= # These parameters are broken into three blocks according to 

"r" # a Prefix in the argument field name. 

O # 

# prefix use 
# 

# mo. — data driving the Cash Register 

# . , this include Payment data and some operational options 

# cpi. — info about the Customer's "Payment Instrument: (credit/check 

# mf . — anything additional you want to pass on 

# to the Fulfillment Center 

my %paymentNVList; 

$paymentNVList{'mo.cybercash-id'} = $cybercashld; 

$paymentNVLi st { 'mo. version ' } = $CyberC : : CCMckLib3_2 : :MCKversion; #CC PS mess acre 

version mc^aye 




# The MO and CPI blocks are not signed, since 

# the message will be encrypted 

$paymentNVLi s t { 'mo. signed- cpi ' } = "no"; 



# load payment instrument info from form 

if{ ! defined { $order {order_id} ) || ! $order {order_id} ){ 

$paymentNVList{ 'mo . order-id' } = mc_comp { ' /shared/utils/uniqueld ' ) ; 
} else { 

$paymentNVList { 'mo . order-id' } = $order{order„id} ; 

} 



$paymentNVList { 'mo .price ' } 
$paymentNVList{ ' cpi . card-number ' } 
$paymentNVList { ' cpi . card-exp' } 
p_year ' } ; 

$paymentNVList { ' cpi . card-name ' } 
t_name ' } ; 

$paymentNVList { ' cpi . card-address ' } 
$paymentNVList { ' cpi . card-city' } 
$paymentNVList { ' cpi . card-state ' } 
$paymentNVList{ ' cpi . card-zip' } 
$paymentNVList { ' cpi . card-country ' } 



= 'USD '. $order{ ' amount '} ; 
= $cc { ' card_number ' } ; 

= $cc { ' card_exp_month' }.'/'. $cc { ' card__ex 

= $ sender {' firs t„name' }. ' ' . $sender { ' las 

= $sender {' street '}. ' ' . $sender {apt} ; 

= $sender { ' city ' } ; 

= $ sender {' state '} ; 

= $sender { ' zip' } ; 

= $sender{ ' country' } ; 



[3 This is a CREDIT CARD payment 

DON'T TOUCH THIS! This is the CR script that will process your payment 
'' : -Sy $script = "direct car dpayment . cgi " ; 

+ ########################### 

"'-4 # No signatures required to talk to the Cash Register 

In # NO SSL required to talk to the Cash Register either... 

# Since the whole thing is encrypted, crooks can't mess with it 
^ # and can't read it either! 

m ########################### 

I # merchant-id gets added to the URL by the connection routine. 
Don't add it here... 

i="my $paymentURL = " $ccpsHost$script " ; 

jljAt this point, all of the data that needs to go into the Payment message 

should have been collected: So, we can call the Cash Register 
~:^Y ($POPref, $tokenListref ) = CyberC : : CCMckDirectLib3_2 : : doDirect Payment ( $payme 
llJitURL, \%paymentNVList) ; 

%POP = %$POPref; 

%tokenList = %$tokenListref ; 

my $POPstr = $tokenList { ' POP ' } ; 

if ($POP{ 'pop, status ' } =~ /^success-duplicate/ ) { 

#add a message to the template 

$tokenList{ 'DUPLICATEJXISG' } 

= "<p>Please note that this order is a duplicate of one complete 
d previously</p>\n" ; 
} 

else { 

$tokenList{ ' DUPLICATE_MSG' } = " # put in a blank to ensure substituti 

on 



•mmmm: 
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CyberC: :CCMckLib3_2 : :CCDebug ( "Exiting $0\n" ) ; 

return (\%POP, \%tokenList) ; 

</%init> 



/? 
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<%PERL_ARGS> 
$selected=> ' ' 
$name=> ' ' 
</%PERL_ARGS> 
<%PERL_INIT> 

my @card_types = mc_comp( ' /shared/ credit /card_types ' ); 

</%PERL_INIT> 

<SELECT NAME= n <%$name%>"> 

<OPTION VALUE="-l">Select card type 
% foreach my $type (@card_types ) { 
% if( $selected eq $type-> { ' code ' } ) { 

OPTION VALUE="<%$type->{ 'code' }%>" SELECTEDx%$type-> { ' name ' } %> 
% } else { 

<OPTION VALUE="<%$type->{ 'code' }%>"><%$type->{ 'name' }%> 

% } 
% } 

</SELECT> 




IP: 
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<%init> 

$old = mc_comp ( ' /shared/utils/hexpair2str ' , old=>$old) ; 

$old = mc_comp { ' /shared/utils/xorf romf ileblock' , old=>$old, fname=>$fname, offs 

et=>$of f set) ; 

return $old; 

</%init> 

<%args> 

$old 

$fname 

$of f set 

</%args> 



1 
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<%once> 

use LWP: :UserAgent; 

use LWP : : Protocol : : https ; 

use HTTP: : Cookies; 

use HTTP: : Request; 

use HTTP: : Response; 

use HTML: : Entities; 

#use URI: :URL qw(url) ; 

</%once> 

<%INIT> 

my $MYIP = 'sproxy.luciditygifts.com'; 
my $ua = new LWP: :UserAgent; 

my $uri = mc_dhandler_arg { ) ; 

my $ content; 

mc_comp { ' show_url ' , lucid__url=>$uri , lucid__ua=>$ua, %ARGS, STORE=>\$content ) 

</%INIT> 

<% $content %> 
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<%init> 

$old = mc_comp { ' /shared/utils/xorf romf ileblock' , old=>$old, fname=>$fname, offse 
t=>$of f set) ; 

$old = mc_comp { ' /shared/utils/str2hexpair ' , old=>$old) ; 

return $old; 

</%init> 

<%args> 

$old 

$ f name 

$of f set 

</%args> 



<%INIT> 

$otburl = "http://10.20.1.54/push/get_amount?u_id=$uid" 
my $reg = new HTTP: : Request 'GET', $otburl< 
my $otb_var; 

my $res = $ua->request ( $req) ; 
if ($res->code eq '200') { 

©pairs = split(/W, $res->content) ; 
foreach $pair (©pairs) { 

{$name, $value) = split(/W, $pair> ; 
$otb_var{$name} = $value; 

} 

return $otb„var { ' amount ' } ; 
} else { 



return "HTTP/1.0 200 OK \nCon tent- type : text/html \n\n<h2>f atal error 3561100 
: unable to reach otb server. \n"; 



-012 

exi t ; 
} 

</%INIT> 



<%ARGS> 

$u_id=>undef 

</%ARGS> 



^mmm&^$r&u: ■■■■■■ 
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<%init> 
my %bma 



return %bma; 

</%init> 

<%args> 

$IDbma=>undef 

$LOC=>undef 

$DLY=>undef 

$cat=>undef 
(3|src=>undef 
,r$sps=>undef 
^rss=>undef 
'^rcs=>undef 
3 rj£OPTV=>undef 
■ ] $BMN=>undef 
_ j$ET=>undef 
ij|EF==>'undef 
i^NT=>undef 
;r|NF=>undef 
y $gif tcat=>undef 
„ $amount=>undef 
\ „</%args> 



"IDbma '* 
"LOC " 
" DLY " 
"cat " 
" src " 
"res " 
" sps " 
"rss" 
" OPTV " 
" BMN" 
" ET " 
" EF" 

it ]sjrp it 

" NF " 

"gif teat" 
" amount " 
) ; 



=> 
-> 



-> $ IDbma, 
=> $LOC, 
=> $DLY, 
=> $cat, 
=> $src f 
$rcs , 
$sps , 
=> $rss, 
=> $OPTV, 
=> $BMN, 
=> $ET, 
=> $EF, 
= > $NT , 
=> $NF, 
=> $gif teat, 
=> $ amount, 
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<%doc> 

this component queries the database based on the passed arguments and determines 
if card has been created for user. If so, it returns the card number. If not, 
it returns a 0. 

</%doc> 

<%init> 

my $ c ar d_no = 0 ; 

my $sql = 'select rcv_giftcard from orders where u_id=:l'; 
my $dbh = DBI->connect ( 'DBI : Oracle : ligifts ' ) 

or die "Couldn't connect to database: " . DBI->errstr; 
my $sth = $dbh->prepare ($sql) 

or die "Couldn't prepare statement: " . $dbh->errstr ; 



return $card_no; 
</%init> 
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# ! /usr/local/bin/perl 
package HTML: : Mason; 
# 

# Sample Mason handler. 
# 

use HTML: : Mason; 
use strict; 

# Uncomment the next line if you plan to use the Mason previewer, 
#use HTML: :Mason: : Preview; 

# List of modules that you want to use from components (see Admin 

# manual for details) 
{ 

package HTML: : Mason: : Commands; 
use CGI qw( : standard) ; 
use CGI: : Cookie; 
use Date::Manip; 
use LWP: :UserAgent; 
use HTTP: : Cookies; 
use HTTP: : Request; 
use HTTP: : Response; 
use HTML: : Entities ; 
15 use Apache :: Session: : File; 

"--I Create Mason objects 

^Hiy $parser = new HTML: : Mason: : Parser; 
Tftiy $interp = new HTML: : Mason: : Interp 

i*i parser=>$parser, 

];-f comp_root=> ' /home/ lucidity/ f ront/sproxy/comps ' , 
IP data„dir=>' /home/lucidity/front/ sproxy/mason' 
s ) ; 

H my $ah = new HTML :: Mason: : ApacheHandler (interp=>$interp) ; 
-^ah->auto„send_headers ( 0 ) ; 

i is 

iff Activate the following if running httpd as root (the normal case) . 

Resets ownership of all files created by Mason at startup. Change 
ItM these to match your server's 'User 7 and 'Group'. 

iSphown (scalar (getpwnam "nobody")/ scalar (getgrnam "tech"), 
$interp->f iles_written) ; 

sub handler 
{ 

my $r = shift; 

# If you plan to intermix images in the same directory as 

# components, activate the following to prevent Mason from 

# evaluating image files as components. 
# 

return -1 if $r->content„type $r->content_type !~ m| A text/|io; 

# This block of code can be enabled to create a session-hash that every 
#* component can access. This is useful for maintaining state across 

# multiple requests. The Apache :: Session module is required. 
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# 

#my %session; 

#my $cookie = $r->header_in ( 'Cookie' ) ; 
#$cookie =~ s/SESSION_ID=(\w*) /$1/; 

#tie ^session, ' Apache :: Session :: File ' , $cookie, {'Directory' => ' /tmp/sessi 
on'}; 

#$r->header_out { "Set-Cookie" => "SESSION„ID=$session{_session_id} ; " ) if ( ! $ 
cookie ) ; 

# This creates a global called %session that is accessible in all components 

# Feel free to rename this as needed. 
# 

#local * HTML :: Mason :: Commands :: session = \%session; 

$ah->handle_request ( $r) ; 

#untie %HTML: : Mason: : Commands: : session; 

} 

1; 
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HTTP/1.1 200 OK 

Date: Wed, 16 Feb 2000 23:13:00 GMT 

Server: Apache/1.3.9 (Unix) mod_perl/l . 21 mod_ssl/2 . 4 . 10 OpenSSL/0 . 9 . 4 
Let You Know: Where it's at : 0 
Content-type: text/html 
Code: 2 00 
Connection: close 
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<%init> 

return unpack ('a*', pack('H*', $old) ) ; # Can return huge string 

</%init> 

<%args> 

$old 

</%args> 
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ServerName sproxy . luciditygif ts . com 
ServerType standalone 

Port 443 

ResourceConf ig /dev/null 
AccessConfig /dev/null 

DefaultType text/html 
#Options -Indexes 

SSLEngine on 
SSLVerifyClient 0 
SSLVerifyDepth 10 

SSLCertif icateKeyFile /home /lucidity/ f ront/ sproxy/ servers /conf / keys /server . key 
SSLCertif icateFile /home/lucidity/ front /sproxy/ servers /conf /keys/ sproxy . crt 

User nobody 
Group tech 

ServerRoot /home /lucidity/ front /sproxy/ servers 
DocumentRoot /home/lucidity/ front/ sproxy/comps 

ErrorLog logs/error 

LogFormat "%h %1 %u %t \"%r\" %s %b \ "% {Ref erer} i\ " \ "% {User-Agent} i\ " \"%{cooki 
i3}n\" %T M 

.ffransf erLog logs /access 

'^ilaxClients 60 
= g tart Servers 50 
.[MinSpareServers 40 
^laxSpareServers 60 
yBaxRequestsPerChild 100 

;3pi rectory Index home index.html 

s PerlRequire /home/lucidity/ front /sproxy/ servers/ conf /handler .pi 
I r #PerlTransHandler main: : trans_handler 

flfcLocation /> 

h"| SetHandler perl-script 

5-s? PerlHandler HTML: : Mason 

lU #PerlTypeHandler main : : type_handler 

in #PerlFixupHandler main : : f ixup_handler 

]3</Location> 



<Location /cgi-bin> 
SetHandler cgi-script 
</Location> 

<Location /ps> 

SetHandler perl-script 
PerlHandler Apache: : Status 

</Location> 





<%ARGS> 

$return=>0 

$escape=>l 

</%ARGS> 
<%ONCE> 

use URI: : Escape; 
</%ONCE> 
<%INIT> 
my ©data; 

foreach my $key (keys %ARGS) { 

next if{ $key =~ (return | escape) $/ ); 
if {ref $ARGS{$key} eq 'ARRAY') { 

foreach my $key2 {@{$ARGS{$key} } ) { 

$key2 = uri_escape { $key2 , , " A A-Za-zO-9 " ) if $escape; 
push ©data, " $key-$key2 " ; 

} 

} else { 

my $item = $escape ? uri„escape ( $ARGS{$key} , " A A-Za-zO-9 " ) 



: $ARGS{$key} 



} 



push @data, n $key=$item" ; 



} 



my $data = join ©data; 
'5eturn( $data ) if( $return ); 



, %i/%INIT> 
f<%$data%> 
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<%init> 

$response s/card_number\=\d+ ( \d{4} } \Sc/card„number== , . . $1&7 ; 
$url =~ s/card„number\=\d+ (\d{4} ) \Sc/card_number= . . . $1&/ ; 
my $fh„lock = new IO::File ">>$logf ile . lock" or return 0; 
my $ctdown=5; 

while (! HTML: : Mason : :Utils: :get„lock($fh_lock) ) { 
return 0 unless $ctdown — ; sleep 1; 

} 

my $LOG = new I0::File " »$logf ile " ; 

my $data = « "EOF" ; 

<LWP_CALL> 

< START_DATE> 

$start_date 

< / START_DATE> 

<URL> 

$url 

</URL> 

<RESPONSE> 

$response 

</RESPONSE> 

<END_DATE> 

$end_date 

</END_DATE> 
</LWP„CALL> 
EOF 

"j^rint $LOG $data; 
■Nreturn 1; 
:: Jc/%init> 
r<%cleanup> 
[ r ~$ f h_l ock- > c 1 os e ; 
'^k/%cleanup> 
|fk%ARGS> 

• L|logf ile=> ' / home/ luci di ty / f ront/ www/ data/ lwp_log' 
] =Jj s tart_dat e=>undef 
1 1? end_dat e= >unde f 

$url=>undef 
! $response=>undef 
! s *c/%ARGS> 
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<%once> 

use Sys :: Hostname; 

</%once> 

<%init> 

my $logfile = ' /home/ lucidity/ front /www_secure/data/ ' . $gif teat . '_error . log' ; 

my $data_string; 

my $ hostname = hostname ( ) ; 

$ARGS{card_number} =- s/\d+ (\d{4} ) / . . . $1/ ; 

$url =~ s/card_number\=\d+ ( \d{4} ) \&/card_number= . . . $1&/ ; 

foreach my $key (keys %ARGS) { 

$ARGS{$key} =- s/card„number\=\d+ ( \d{4 } ) \&/card_number= . . . $1&/; 

$data_string .= "$key => $ARGS{$key} \n" ; 

} 

my $fh_lock = new IO::File " »$logf ile . lock" or return 0; 
my $ctdown=5; 

while { i HTML : ;Mason: :Utils: : get_lock { $f h_lock) ) { 
return 0 unless $ctdown — ; sleep 1; 

} 

my $LOG = new IO::File ">>$logf ile" ; 

my $data_log = « "EOF" ; 

<LWP_CALL> 

<DATE> 

$date 

</DATE> 
<HOSTNAME> 
III hostname 

..W/HOSTNAME> 

' : HURL> 

: 4url 

f^/URL> 
; r fRETURN> 

"^return 
r|f/RETURN> 
i^DATA> 
'Hjdata„string 
isSc/DATA> 
. </LWP_CALL> 

; jeof 

ftprint $LOG $data_log; 

Umc_comp( Vshared/utils/send_mail' , subject=>" $gif teat Error $date", text=>$data_ 

I Ore turn 1; 
i=|c/%init> 
^<%cleanup> 
*=3$fh_lock->close; 

</%cleanup> 

<%ARGS> 

$gif tcat=>'gif tcard' 

$return=>undef 

$url=>undef 

$date=>localtime 

</%ARGS> 
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<%doc> 

Will provide a connection to a specified url . 
Will then store the contents in data depending 

on how data was passed, 
passing \$data will store the contents as a string. 

passing \@data will store the contents as an array of name=value pairs, 
passing \%data will store the contents as a hash of name/value pairs. 
The component will return the reutn call of the lwp request. 

</%doc> 
<%once> 

use URI:: Escape; 

</%once> 

<%init> 

my $Sdate = (localtime) [2] . " : " . (localtime) [1] . " : " . (localtime) [0] ; 

my $ua - new LWP :: User Agent ; 

$ua->agent ( "Mozilla/4 . 7 [en] {Lucidity)"); 

$ua->timeout {$ timeout ) ; 

my $req = new HTTP: : Request 'GET',$url; 
my $res = $ua->request ( $req) ; 
my $retry_count = 0; 

# Retry up to 3 times since it is NT that we are hitting... 
while {$res->code ne 200) { 
$retry_count ++; 

if ( $retry_count gt 3) { return $res->code; } 
Q $res = $ua->request ($req) ; 

,"fi 

;|%y $Edate = (localtime) [2] . " : " . (localtime) [1] . " : " . (localtime) [0] ; 
'^Siy $content = $res->content ; 
_f$content - uri„unescape {$content ) ; 

• r mc_comp ( ' /shared/utils/log_call ' , start_date=>$Sdate, end_date=>$Edate, url=>$u 
1:1, response=>$content) ; 
!flf (ref $data eq 'ARRAY') { 
i'4 (@{$data}) = split $content; 
]5 elsif (ref $data eq 'HASH') { 
Us my (@tmp) = split , $content; 

foreach my $key (@tmp) { 
= . my ($name, $value) = split ,, = " / $key, 2; 

$data->{ $name} = $value; 

|5§- else { 

s - $$data = $content; 

IU 

§ Return $res->code; 

;3=/%init> 

i=Jc%ARGS> 

$url 

$data 

$timeout=>5 

$retry=>3 

</%ARGS> 
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<%ONCE> 

use URI: : Escape; 
</%ONCE> 
<%INIT> 
my @data; 

for each my $key (keys %ARGS) { 

next if( $key =~ / A (return | escape) $/ ); 

next if( $key =~ / A lucid__/ ); 

if (ref $ARGS{$key} eq 'ARRAY') { 

foreach my $key2 {@{$ARGS{ $key} } ) { 

$key2 = uri_escape ( $key2 , " A \ . A-Za-zO-9 " ) if $escape; 
push @data, " $key=$key2 " ; 

} 

} else { 

my $item = $escape ? uri_escape { $ARGS{$key} , " A \ . A-Za-zO-9 " ) : $ARGS{$ke 

y); 

push ©data, " $key=$item" ; 

} 



my $data = join @data; 

return ( $data ) ; 

"'S/%INIT> 
;M:%ARGS> 
%|escape=>l 
; fj/%ARGS> 
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# This file controls what MIME types are sent to the client for the 

# given file extensions. Sending the correct MIME type to the client 

# is important so they know how to handle the content of the file. 

# Extra types can either be added here or by using an AddType directive 

# in your config files. For more information about MIME types 

# please read RFC 2045, 2046, 2047, 2048, and 2077. 



# MIME type 

application/ act ivemessage 

app 1 i cat i on /andrew- inset 

application/ applefile 

application/atomi email 

application/dca-rf t 

applicat ion/dec -dx 

application/ luciditykey 

application/mac-binhex40 

application/mac-compactpro 

appl i cat i on / macwr i tei i 

applicat ion/msword 

applicat ion/news -message-id 

applicat ion/news- transmission 

application/ octet-stream 

application/ oda 

application/pdf 

_applicat ion/postscript 
f Jipplication/powerpoint 
application/ remote-printing 
..'^pplication/rtf 
: Application/ slate 
_ gppp 1 i cat ion / smi 1 

application/wita 

*^ppli cat ion /wordperfect 5 . 1 
I J^pplication/x-bcpio 
supplication/ x-cdl ink 
: ifpp 1 i cat i on /x- compress 
ykpplication/x-cpio 
. application/x-csh 
= .application/x-director 
i Applicat ion/x-dvi 
f IJtpplication/x-gtar 
jfapplication/x-gzip 
;;fipplication/x-hdf 
fl^pplication/x- javascript 
i ™app 1 i ca t i on / x-koan 
: Applicat ion/x-latex 
= Applicat ion/x-mif 

application/x-netcdf 

application/x-sh 

applicat ion/x-shar 

application/x-stuf f it 

application/x-sv4cpio 

application/x-sv4crc 

application/ x-tar 

application/x-tcl 

application/x-tex 
application/x-texinf o 
application/x-trof f 
applicat ion/x-troff -man 
application/x-trof f -me 
application/x-trof f-ms 



Extension 



key 
hqx 
cpt 

doc 



bin dms lha lzh exe class 

oda 

pdf 

ai eps ps 
ppt 

rtf 

smi smil sml 



bepio 
ved 

cpio 
csh 

dcr dir dxr 

dvi 

gtar 

hdf 
js 

skp skd skt skm 

latex 

mif 

nc cdf 
sh 

shar 
sit 

sv4cpio 

sv4crc 

tar 

tel 

tex 

texinfo texi 

t tr roff 

man 

me 

ms 
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application/x-ustar 

applicati on /x-wais -source 

application/ zip 

audio/basic 

audio/midi 

audio /mp eg 

audio/x-aif f 

audio/x-pn-realaudio 

audio /x-pn-realaudio-plugin 

audio /x-realaudio 

audio/x-wav 

chemical /x-pdb 

image /gif 

image/ ief 

image/ j peg 

image /png 

image/ tiff 

image /x-cmu-raster 

image /x-portable-anymap 

image /x-portable-bitmap 

image /x-portable-graymap 

image /x-portable-pixmap 

image /x-rgb 

image /x-xbitmap 

image /x-xpixmap 
1 3.mage / x-xwindowdump 
message/ external -body 
^^mes sage /news 
'"-he s sage / par t i a 1 
= gaessage/rfc822 
l~- model /iges 
'4iodel/vrml 
fflao del /mesh 
i Iwul t ipart / al terna t ive 
] jault ipart /appledouble 
Iffiiult ipart /digest 
. multipart/mixed 
\ multipart /parallel 
=i:ext/css 
||fcext/html 
s {text /plain 
=?text/richtext 
| ttext / tab-separat ed-values 
= =£. ex t / x- s e t ex t 
:iext/x-sgml 
^.text/xml 

video /mpeg 

video/ qui cktime 

video /x-msvideo 

video /x-sgi-movie 

x-conf erence/x-cooltalk 



ustar 

src 

zip 

au snd 

mid midi kar 

mpga mp2 mp3 

aif aiff aifc 

ram 

rpm 

ra 

wav 

pdb xyz 

gif 

ief 

jpeg jpg jpe 
png 

tiff tif 

ras 

pnm 

pbm 

pgm 

ppm 

rgb 

xbm 

xpm 

xwd 



igs iges 
wrl vrml 
msh mesh silo 



ess 

html htm 

txt 

rtx 

tsv 

etx 

sgml sgm 

xml dtd 

mpeg mpg rape 

qt mov 

avi 

movie 

ice 



# This is a comment. 1 love comments. 
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<%PERL_ARGS> 
$f irst_month=>' 1' 
$how_many=> ' 12 ' 
$selected=>' ' 
$name=> 'month' 
$style=> ' num' 
</%PERL_ARGS> 
<%PERL_INIT> 

$how_many = ( $how„many > 12 ? 12 : $how__many) ; 
my %names = ( 



1 


=> 


'January' , 


2 


=> 


' Febuary ' , 


3 


=> 


' March ' , 


4 


=> 


'April ' , 


5 


=> 


'May' , 


6 


=> 


' June ' , 


7 


=> 


'July' , 


8 


=> 


' August ' , 


9 


=> 


' September ' 


10 


=> 


' October' , 


11 


= > 


' November ' , 


12 


= > 


' December ' , 



) ; 

i3/%PERL„INIT> 

\ N: SELECT NAME= "<%$name%> " > 

y <OPTION VALUE= " " >Month 
a p foreach my $month (1 . . $how_many) { 
l T % my $month_num = sprintf "%2.2d", $month; 

'4 my $month_name = $names { $month } ; 
Ifl if ( $selected == $month_num ) { 

m <OPTION VALUE="<%$month„num%>" SELECTED><% ( $style eq 'name' ? $month_name 

■ S : $month„num )%> 
I|% } else { 

<OPTION VALUE = ,, <%$month_num%>"><% ( $style eq 'name' ? $month_name : $month 
I _num ) %> 

m > 

-^f/SELECT> 



Lis 



ng for Tony Bautts 



^^im^^lue^iy^ 91^:22:042000 



Page 
7 



<%doc> 

This will return a call from an lwp request with the correct 
name/value pair string, 
syntax : 

<Sc /shared/http/lwp„return, status=>0, msg=> "database down" &> 
</%doc> 

<& /shared/utils/info_string, %ARGS &> 
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"HTTP/1. 0 200 OK\nContent-type: text /html \n\n " ; 
<html> 

<body bgcolor=white> 

<h2>Security Error. Unable to process proxy request . </h2> 

We do not show that you have a gift certificate to use this proxy server 
with. Please contact customer service. 

%exit ; 
<%ARGS> 

</%ARGS> 



*^ 11 11 ' ,. ' . ■ ; - : ■* . . ~ .... 



# 1 /usr/bin/perl 



# (C) 1999 Kit Knox <kit@connectnet . com> 

use LWP: :UserAgent; 

use LWP: : Protocol: :https; 

use HTTP: : Cookies; 

use HTTP: : Request; 

use HTTP: : Response; 

use HTML: : Entities; 

use URI::URL qw{url); 

require "crypto.pl"; 

$MYIP = 'sproxy.luciditygifts.com'; 

$cookie„jar = HTTP: : Cookies->new; 
$ua = new LWP :: User Agent ; 

sub return_int„vars { 

$otburl = "http: //10 . 20 . 1 . 53 /process/return_int_vars?u_id=$l_uid" ; 
my $req = new HTTP :: Request 'GET', $otburl; 
my $otb_var; 

_ my $res = $ua->request ( $req) ; 
O if ($res->code eq '200') { 
.f= ©pairs = split(/\&/, $res->content) ; 
^ foreach $pair (@pairs) { 
"~4 ($name, $value) = split (A=/, $pair) ; 

.C $otb_var{$name} = $value; 

: --U } 

^2 return $otb_var{ 'balance' } ; 
I II } else { 

-;h print "HTTP/1.0 200 0K\nContent-type : text /html\n\n<h2>f atal error 3561100-0 
!:l2 : unable to reach return__int_vars server. \n"; 
U l exit; 
} 

\J 

ithub get_amount { 

m $otburl = ,, http://10.20.1.54/push/get„amount?u_id=$l_uid l, ; 
Ir. my $req = new HTTP: : Request 'GET', $otburl; 
\U my $otb_var; 

IS rny $res = $ua->request ( $req) ; 
if ($res->code eq '200') { 

©pairs = split(/\&/, $res->content) ; 
foreach $pair (©pairs) { 

($name, $value) - split(/\=/ f $pair) ; 
$otb_var { $name } = $value ; 

} 

return $otb_var { ' amount ' } ; 
} else { 

print "HTTP/1. 0 200 OK\nContent-type : text /html \n\n<h2>f atal error 3561100-0 
12: unable to reach otb server. \n" ; 
exit; 

} 

} 

sub no_cookiemonster { 
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print "HTTP/1. 0 200 OK \nC on tent- type : text/html \n\n" ; 
print " 
<html> 

<body bgcolor=white> 

<h2>Security Error. Unable to process proxy request . </h2> 

We do not show that you have a gift certificate to use this proxy server 

with. Please contact customer service, 
ii . 

exit; 

} 

sub parse_cookiemonster { 

©pairs = split (/; / , $ENV{ 'HTTP„COOKIE' } ) ; 
foreach $pair (©pairs) { 

($name, $value) = split (/=/, $pair) ; 
$cookies {$name} = $value; 

} 

©pairs = split </\&/, $cookies{ ' LUCIDITY_COOKIEMONSTER' } ) ; 
foreach $pair (©pairs) { 

(Sname, $value) = split (A./, $pair) ; 

$cookies {$name} = $value; 

} 

$l„name = fcxorfromf ileblock(hexpair2str ( $cookies{ 'name' } ) , "private. key" , 0); 
$l„gcn = &xorfromf ileblock {hexpair2str ($cookies{ 'gen' } ) , "private . key" , $cooki 
Ij|s{ 'pkof f ' }) ; 

,n $!_9 ce = &xorfromfileblock(hexpair2str($cookies{'gce'}) , "private .key" , 0) ; 

$l_mm = substr ($l_gce, 0, 2) ; 
*H $l_yyyy = substr ($l_gce, 2, 4); 

$l_uid = $cookies{ 'uid' } ; 

$l_damt = &xorfromfileblock{hexpair2str ($cookies{ 'damt' } ) , " private. key " , 0) ; 
if ($l_damt eg ' ' && $F{ / damt / } eq " ) { 
y] &no_cookiemonster ; 

y 

= sub replacelink 

I A 

=1. my{$pre, $type, $quote, $url, $base) = @_; 
I'll nvy ($prepend) = " " ; 

if (grep(/ A https\:/, $url) ) { 
iU $prepend = "https://sproxy.luciditygifts.com"; 

)% if (grep(/ A http\:/, $url) ) { 

M $prepend = "http://sproxy.luciditygifts.com"; 

> 

$url = url($url, $base)->abs; 
if ($type eq 'area' || $type eq 'a') { 
if ( !grep (/ javascript /i, $url) ) { 

$url = " $prepend/cgi-bin/nph-borders\/$url " ; 

} 

} 

if ($type eq 'form') { 

$url = "$prepend/cgi-bin/nph-borders\/$url" ; 

} 

# if {grep(/^https\:/, $url) && $type eq 'img'} { 

# $url =~ s/http:/https:/g; 

# > 




to 
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return $pre . $quote . $url . $quote; 

} 

sub show_banner { 

local ($ct=shift (@_) ) ; 

if ($ct eq 'text/html'} { 

print "<table width=100% bgcolor=\ " #000000\ "xtrxtdxf ont color=white>Lucid 
ity HTTP Proxy — Your requests are currently being proxied. </f ontx/ tdx/ trx/ 1 
able>\n" ; 

} 

} 

sub show_url { 

local ($url) = shift{@_); 

&parse_cookiemonster ; 

$ times tamp = time; 

if (grep(/ A https\ : /, $url)) { 

$trail_pre = "https://strail.luciditygifts.com"; 
} else { 

$trail__pre - "http://trail.luciditygifts.com"; 

} 

# Borders Credit Card Submit 

if {grep (/ . *borders . com. *gif ttest .d2w\ /report /i, $url) ) { 
^ $url = $url . "&cctype=l&ccnum=" . $l_gcn. ,, &ccxmonth=$l_mm&ccxyear=$l_yyyy&ccn 
f3Lme=Lucidity%20Inc" ; 

ri if ($F{'emethod' } ne " ) { 

' ^ $ENV{ ' REQUEST_METHOD ' } = " GET " ; 

^1 my $req = new HTTP: : Request $ENV{ ' REQUEST_METHOD ' } , $url ; 
_2 if <$ENV{ 'REQUEST_METHOD' } eq 'POST') { 

III $req->content_type ( ' application/x-www-f orm-url encoded' } ; 
= === $req->content { $post_buf f er ) ; 

IS } 

# Import Cookies 

L $cline = $EW{'HTTP_COOKIE'}; 
f~ $cline = ~ s/\"//g; 

|1J $req->push__header ( "Cookie" , $cline) ; 

lt\ # Some sites need a real looking referer. 
1U $req->push_header ( "Referer" , $url) ; 

□ $req->push_header ( "Authorization" , $ENV{ ' HTTP_AUTHORIZATION ' } ) ; 

^ # Proxy True Agent 

# $ua->agent ( $ENV{ ' REMOTE_AGENT ' } ) ; 

$ua->agent ( "Mozilla/4 . 7 [en] (Xll; U; Linux 2.2.10 i586)"); 



my $res = $ua->request ( $req) ; 

# Return the proper response code. 
$code = $res->code; 

print "HTTP/ 1.1 $code 0K\n" ; 

# Handle Location Redirects 

if ($res->_header { "Location" ) ) { 

$newurl = sprintf ( "%s " , $res->_header ( "Location" }) ; 
print "Location: /cgi-bin/nph-borders/ $newurl\n" ; 
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} 

# Export Cookies 

©cookies = $res->_header ( "Set-Cookie" ) ; 
foreach $cookie (©cookies) { 

$cookie =~ s/domain= . *?\ ; //g; 

$ cookie =- s/domain= . *?\ " / /g; 

$cookie =- s/domain= . *?\n//g; 

$cookie =- s/Set-Cookie3/Set-Cookie/g; 

print "Set-cookie: $cookie\n"; 

} 

if {$F{ 'emethod' } ne " ) { 
# print "Set-Cookie: LUCIDITY_COOKIEMONSTER=&emethod. $F{ ' emethod '} &pkoff . $F { ' 
pkof f ' }&name. $F{ 'name' }&gcn. $F{ 'gen' }&gce. $F{ 'gee' }&uid. $F{ 'uid' }&damt. $F{ 'damt ' 
}; domain= . luciditygif ts . COM; path=/;\n"; 

print "Set-Cookie: LUC I DI TY_COOKI EMONSTER= & erne t hod , $F{ ' emethod' }&pkof f . $F{ 'p 
kof f ' }&name.$F{ 'name' }&gcn.$F{ 'gen' }&gce. $F{ 'gee' }&uid. $F{ 'uid' }&damt . $F{ 'damt' } 
; path=/;\n" ; 

} 

# Convert to absolute references 
$content = $res->content ; 

my $base = $res->base; 

# Chip Shot uses action= tags within their CGI URL. Ackl 
if ( !grep( / chipshot.com/ i, $url) ) { 

0 $content =~ s/ 

< ( img | a | body | area | frame | td| input | f orm| link | script) \b 

N [*>] + 

.c \b(? :src | href (background | action) 

[ ! s \s*=\s* 

-4 ) 

m (?: {")([""]*)" I (')<["']*>' I ([ A \S>]+) ) 

^ replacelink<$l, lc($2), $3||$5, HTML :: Entities :: decode { $4 | | $6 | | $7 ) , 

1 Tl $base) /giex; 
5 } else { 

] . $content =~ s/ 

Ul < {img | a | body | area | frame | td| input | form] link | script) \b 

5 - \b(? :src | href | background) 
lU \s*=\s* 

U {? . (")([-»]*)» | (')([-']*)' | <r\s>]+) ) 

replacelink{$l, lc($2), $3||$5, HTML : : Entities : : decode { $4 | | $6 | | $7 ) , 
$base) /giex; 

} 

######################## BEGIN Replace HTML 

# Borders 

# Remove Credit Card Form 

$COntent =~ s / <TABLE BORDER= \ " 0 \ " CELLPADDING= \ " 5 \ " CELLSPACING=\ " 0\ " WIDTH=\" 
590\"> \n\t\t\t\t\t\t\t<TR VALIGN=\ " top\ " > . *?steps\ / 5 . gif . * ?why your order is se 
cure.*?Credit Card Number . *?<\/TD>\n\t\t\t\t\t\t\t<\/TR>\n\t\t\t\t\t\t<\/TABLE>\ 
n\t\t\t\t\t\t\&nbsp\; //s; 

# Remove Gift Certificate Form 




$content =~ s / <TABLE BORDER= \ " 0 \ " CELLPADDING=\ " 5\ " CELLSPACING=\ " 0\ " WIDTH=\" 
590\">\n\t\t\t\t\t\t\t<TR VALIGN=\"top\">.*?steps\/4,gif .*?balance via our shipm 
ent confirmation email . <\/Px\/SMALL>//s ; 

# Remove "Your credit card will be charged" 

$content =~ s/Your credit card will be charged. *?less the amount of any Gift C 
ertificate you entered above \ } . <BR>//s ; 

# Remove Quick Checkout - It saves the credit card. 

$COntent =~ s / < TABLE BORDER= \ " 0 \ " CELLPADDING= \ " 0 \ " CELLSPACING= \ 11 0 \ " ALIGN= \ " 
left\">\n\t<TR>\n\t\t<TD WIDTH=\ 11 3 5\ " COLSPAN=\ 11 3 \ " ROWSPAN=\ " 3 \ " > . *?checkout_q . 
gif.*?Quick Checkout Prof ile<\/A> . / /s ; 

# Convert "Order Online" option to hidden var 

$content =~ s/<INPUT TYPE=\ " radio \ " NAME=\ "url\ " VALUE=\ " \ /msprotect\ /ncommerc 
e\/\;order\/display\?status=P\" CHECKEDxB>Order Online<\ /B>/< INPUT TYPE=\"hidde 
n\" NAME=\"url\" VALUE=\ " \ /msprotect\ /ncommerce\ / \ ; order \ /display\ ?status=P\ " >/s 

# Remove "Order by phone or fax 

$content =~ s/<INPUT TYPE=\ "radioV NAME=\"url\" VALUE=\ " \ /msprotect\ /getcooki 
e\?url=\/msprotect\/ncommerce\/\;order\/display\?status\=P\"><B>Order By Phone 0 
r Fax<\/B><BR>//s; 

# Fix CGI Ref 

$content =~ s/cgi-bin\%OA/cgi-bin/s ; 

# Remove Quick Checkout after they create a profile 

$content =~ s/Also\, please note that we've made ordering. *?and videos with a 
single click ! <\/P>//s ; 

# Remote Quick Checkout Bar Link 

^3 $content =~ s/Your Quick Checkout Profile/ /s; 

$total_purchase = 0; 

•sj if (grep(/\<TD COLSPAN=3 BGCOLOR=\ " \#FFFFCC\ " \>\<B\>Total\<\ /B\>\<\ /TD\>/ , $co 
mtent)) { 

;r ($sa, $sb) = split (/\<TD COLSPAN=3 BGCOLOR=\ " \#FFFFCC\ " \>\<B\>Total\<\ /B\>\< 
*H/TD\>\n\n \<TD ALIGN=\ " RIGHT \ " WIDTH=\ " 70\ " BGCO 

fftOR=V'#FFFFCC\"\>\<FONT SIZE=\ " 2 \ " \>\<B\>\$ /, $content) ; 
]~_ ($total_purchase, $sb) = split ( /\<\/B\>/ , $sb) ; 



y! if ( $total_purchase > 0} { 

s $return_int„vars = &return_int_vars ; 

I _ $get__amount = &get_amount; 

I"" 5 " $otb = $return_int_vars - $get_amount ; 

l|j if ($total_purchase > $otb) { 

If: $escaped_url = $url; 

\& $escaped_url =~ s/\%/\%25/g; 

j=j $escaped__url =~ s/W\%26/g; 

$escaped_url =~ s/\;/\%3b/g; 

O print "Content- type: text /html \n\n<meta http-equiv=ref resh content=\ " 1 ; ur 

l=https : / / fund. luciditygif ts . com/gif tcard/add?store=borders . com&uid=$l„uid&damt= 
$totalj?urchase&returnurl=https : / /sproxy . luciditygif ts . com/cgi-bin/nph-borders/$ 
escaped_url\ ">\n 

<img src=\ "$trail_pre/l /decline/borders . com/main/$l_uid/$l_damt/$timestamp\ " wid 
th=0 height=0>\n 

<! — DEBUG: otb query: $otb ($return„int_vars - $get„amount) , total purchase: $t 
otal_purchase, you need more money I Redirect in 1 sec. — >"; 



exit; 



} 



######################## END Replace HTML 



# We do absolute paths and disable base hrefs 





$content =~ s/base href =\ " /basehref =\ " /ig; 



# Return the proper auth realm 

@auths = $res->_header ( "WWW-authenticate" ) ; 
foreach $auth (@auths) { 

print "WWW-authenticate: $auth\n" ; 

} 

# Handle Meta Refresh **** FIX REGEX TO HANDLE ANY DELAY *** 
$content =~ s/\ " 0\ ;URL=/\ " 0\ ;URL=\/cgi-bin\/nph-borders\//g; 
$content =~ s / \ " 3 \ ; URW \ " 3 \ ; URL=\ /cgi-bin\ /nph-borders\ / /g; 

# Borders.com uses javascript to do redirects. WHY!@#$ 

$content =- s /window. location. replace \ { \ " /window. location. replace \(\" \/cgi-b 
in\ / nph-border s \ / / g ; 

$content =~ s /window. location. href = 'http: \ /\/www. border s . com/ window. location. h 
ref = ' \/cgi~bin\/nph-borders\//g; 

$content = ~ s/window. location. href = 'https : \/\ /www. borders . com/window. location, 
href = J \ /cgi-bin\ /nph-borders \ / /g; 

$ct = $res->content__type; 
print "Content-type: $ct\n\n"; 
print $content; 

# Pixel Calls 

13 if (grep { / \<basehref =\ "http: \/\ /www. borders ,com\/\ " \>/ , $content) ) { 

\f print "<img src=\ " $trail_pre/l /enter/borders . com/main/ $l_uid/$l_damt /pixel . g 

Hi f\ ?$ times tamp\" width=0 height=0>\n" ; 

'4 } 

P if {grep ( / \<TITLE\>Borders . com - Standard Checkout<\/TITLE\>/ , $content} ) { 

print "<img src=\ " $trail_pre/l/checkout/borders . com/main/ $l_uid/$l_damt/pixe 
s 4.gif \?$timestamp\" width=0 height=0>\n" ; 

j~ if ( grep ( / <TITLE>Border s . com - Your Receipt<\/TITLE>/ , $content) ) { 

^ if (grep{/BGCOLOR=\"\#FFFFCC\"\>\<B\>Total\<\/B\>\<\/TD\>/, $content) ) { 

iH ($sa, $sb) = split (/BGCOLOR=\"#FFFFCC\"\>\<B\>Total\<\/B\>\<\/TD\>\n\n 

\<TD ALIGN=\ " RIGHT \" width=70 BGCOLOR=\ " #FFFFCC\ " ><F 
! ONT SIZE=\"2\"\>\<B\>\$/ / $content) ; 

H {$total_purchase, $sb) = split {/ \<\ /B\>/ , $sb) ; 

\Y\ $ to tal_pur chase =- s/ //g; 

i'f, } 

print u <img src=\ " $trail_pre/ 1/approval /borders . com/main/ $l_uid/$total_purch 
Uase/pixel .gif \?$ times tamp\" width^O height=0>\n" ; 

sub parse_input { 

©pairs = split(/&/, $post_buf fer) ; 

foreach $pair (@pairs) 

{ 

($name, $value) = split (/ = /, $pair) ; 
$value =~ tr/+/ /; 

$value =~ s/%( [a-fA-FO-9] [a-fA-FO-9] ) /pack( "C" , hex($l})/eg; 
$F{$name} = $value; 

} 



$uri = $ENV{ ' REQUEST_URI ' } ; 

$uri s/\/cgi-bin\/nph-borders\/ //g; 



# Hack for Javascript Redirect 

if { igrep(/http (.*):/ , $uri) grep ( /ncommerce/i , $uri) } { 
if ( $ENV { ' HTTPS ' } eq 'on') { 

$uri = "https://www.borders.com" . $uri; 
} else { 

$uri = "http://www.borders.com" . $uri; 

} 

} 

read(STDIN f $post_buf f er , $EW{ 'CONTENT_LENGTH' } ) ; 
&parse„input ; 

# Before making an SSL connection we need to rid ourselves of the SSL 

# vars we inherit from modssl. 
for each $env (keys %ENV) { 

if (grep < /"SSL/, $env) ) { 
$ENV{$env} = "; 

} 

} 

&show_ur 1 ( $uri ) ; 
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<%INIT> 

©pairs = split (/; / , $ENV{ 'HTTP_COOKIE' } ) ; 
foreach $pair { ©pairs) { 

{$name, $value) = split(/=/, $pair) ; 

$cookies{ $name} = $ value; 

} 

©pairs = split </\&/, $COOkies { ' LUCIDITY_COOKIEMONSTER ' } ) ; 
foreach $pair { ©pairs) { 

($name, $value) = split {/\./ r $pair) ; 

$cookies { $name} = $value; 

} 

$l_name = &xorfromf ileblock (hexpair2str ($cookies{ 'name' } } , "private . key" , 0) ; 
$l__gcn = &xorfromf ileblock (hexpair2str ( $cookies{ ' gen' }) , "private . key " , $cooki 
es{ 'pkoff ' }} ; 

$l_gce = Scxorfromf ileblock (hexpair2str ($cookies{ 'gee' }) , "private . key" , 0} ; 
$l_mm = substr ( $l_gce, 0, 2); 
$l_yyyy = substr {$l_gce, 2, 4); 
$l_uid = $cookies{ 'uid' } ; 

$l__damt = kxorfromf ileblock (hexpair2str {$cookies{ f damt' }) , "private .key" , 0) ; 
if ($l_damt eq ' ' $F{'damt'} eq ' ' ) { 
&no_cookiemonster ; 

} 



</%INIT> 
<%ARGS> 
i3/%ARGS> 
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<%INIT> 
my %F; 

@pairs = split (/&/, $post_buf fer) ; 
foreach $pair ( ©pairs) { 

my ($name, $value) = split (/=/, $pair) ; 

$value =- tr/+/ /; 

$value =~ s/% { [a-fA-FO-9] [a-fA-FO-9] ) /pack("C" , hex($l))/eg; 
$F{$name} = $ value; 
return %F; 

} 

</%INIT> 
<%ARGS> 

$post„buf f er=>undef 
</%ARGS> 




Hi 



Date: Wed, 16 Feb 2000 23:23:59 GMT 



Let You Know: Where it's at : Cache-Control : no-cache Date: Wed, 16 Feb 2 00 0 23 

:22:10 GMT Pragma: no-cache Server: Netscape-Enterprise/3 . 5 . 1 Content-T 

ype: text/html Expires: Thu, 01 Dec 1994 16:00:00 GMT Client-Date: Wed, 16 

Feb 2000 23:24:01 GMT Client-Peer: 32.97.253.81:443 Client-SSL-Cert-Issue 

r: /C=US/0=RSA Data Security, Inc . /OU=Secure Server Certification Authority C 

lient-SSL-Cert-Subject : /C=US/ST=Michigan/L=Ann Arbor/0=Borders Group, Inc . /OU=B 

orders Online/OU= Terms of use at www.verisign.com/RPA (c) 99/CN=www. borders . com 

Client-SSL-Cipher : EXP-RC4-MD5 Client-SSL-Warning: Peer certificate not ver 

ified Title: Borders.com - Your Info 

Content-type: text/html 
Code: 200 
Connection: close 

cook: Set headers : cookie to , referer to https://www.borders.com/cgi-bin/ncommer 
ce3 /Logon and Autorization to <BR>C0NTENT: 



<!D0CTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional/ /EN " "http://www.w3.org 
/ TR / REC -html40/loose.dtd"> 

<!— HEAD-BODY . INC — > 
<HTML> 
<HEAD> 

<TITLE>Borders . com - Your Info</TITLE> 

<meta http-equiv= " Pragma" content^ "no-cache "> 

<meta http-equiv= "Expires " content= "Thu, 01 Dec 1994 16:00:00 GMT " > 
<meta http-equiv= "Cache-Control " content= "no-cache " > 



mnior Tony Bautts wed, w Fet \20wiM. 



</HEAD> 

<BODY BGCOLOR="#f f f fee" LINK= " #663300 " VLINK= " #999999 " TEXT= " #000000 " LEFTMARG 
IN= 11 8 " TOPMARGIJSN " 8 " > 
<A NAME="top"></A> 

<!— BEGIN GNB — > 

< TABLE BORDER- " 0 " WIDTH= " 10 0% " CELLS PACING = " 0 " CELLPADDING^ " 0 " > 
<TR> 

<TD ROWSPAN="3 "><IMG SRC="https: / /www. borders . com/ web_images/ 2 /head/ gnav 
-commerce.gif " WIDTH= 11 610 " HEIGHT="29" BORDER- " 0 11 USEMAP=" #map_navigation" x/TD> 
<TD WIDTH= U 100%" HEIGHT="26"xSPACER TYPE= "block" WIDTH="1" HEIGHT= " 2 6 " > 

</TD> 

</TR> 
<TR> 

<TD WIDTH="100%" HEIGHT^ " 1 11 BGCOLOR= " #333300 " xSPACER TYPE= "block " WIDTH 
="1" HEIGHT="l"x/TD> 
</TR> 
<TR> 

<TD WIDTH="100%" HEIGHT= " 2 " BGCOLOR= " #cccc99 "xSPACER TYPE= "block" WIDTH 
="1" HEIGHT="2 n ></TD> 
</TR> 
<TR> 

<TD COLSPAN="2 M BGCOLOR= " #cccc99 " > 

<TABLE BORDER= " 0 " CELLSPACING= " 0 " CELLPADDING= " 0 " > 

<FORM METHOD="get" ACTION= " http : / /proxy . luciditygif ts . com/borders /http : / 
iH search. borders . com/ f cgi-bin/db2www/ search/search. d2w/QResults ">< INPUT TYPE="hid 
'Sen" NAME="doingQuickSearch" VALUE="1 B >< INPUT TYPE= "hidden " NAME="srchPage" VALU 
k h&=" QResults"> 
k -d <TR> 

3*j <TD WIDTH="1" BGCOLOR="#333300"><SPACER TYPE="block" WIDTH="1" HEIGHT= 

;H , 1"></TD> 

'"•=4 <TD VALIGN= " center " >&nbsp ; &nbsp ; &nbsp ; <B>Find</B> <INPUT TYPE= " text " 

f |VALUE= " " NAME=" keyword" SIZE="25" MAXLENGTH^ " 1 5 0 " >   <B>in</B> <INPUT TYPE= 
radio" NAME="mediaType" VALUE= ,l Book" CHECKED >Books <INPUT TYPE= " radio" NAME= " 
;4iediaType" VALUE=" Music" >Music <INPUT TYPE="radio" NAME="mediaType" VALUE="Vid 
ifto" >Videos  <INPUT TYPE= " submit " NAME= 11 submi t " VALUE="Find! " >  <A HR 
EF-"http: / /proxy . luciditygifts . com/borders /http: / /search .borders . com/f cgi-bin/db 
" 2www/ search/ search . d2w/BookKeyword" >Help</Ax/TD> 
|=* </TR> 
= !i </FORM> 
I s ~ <TR> 

IU <TD HEIGHT= " 2 " WIDTH= " 1 " BGCOLOR= " #333300 " ><S PACER TYPE= "block" WIDTH= 

fU'l" HEIGHT="2"x/TD> 

<TDx/TD> 
U </TR> 
13 </TABLE> 
</TD> 
</TR> 
<TR> 

<TD COLSPAN="2" BGCOLOR=" #000000 "> 

<TABLE BORDER^ " 0 " CELLSPACING= " 0 " CELLPADDING= " 0 " > 
<TR> 

<TD WIDTH="1" HEIGHT="2" BGCOLOR^ " #333300 " >< SPACER TYPE= "block" WIDTH= 
"1" HEIGHT="2"x/TD> 
</TR> 

</ TABLE > 
</TD> 
</TR> 
</TABLE> 
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<MAP NAME="map_navigation"> 

<AREA SHAPE="rect" ALT= " Borders . com" 

COORDS= " 1 ; 1 , 155 , 29 " HREF= "http : / /proxy . luciditygifts , com/borders /http 
:/ /www. border s . com/ " > 

<AREA SHAPE= n rect" ALT= "Books " 

COORDS=" 156,1,203,29" HREF= "http: / /proxy . luciditygifts . com/borders /ht 
tp : / /www. borders . com/sections/section_10000 . html " > 
<AREA SHAPE="rect" ALT= "Music" 

COORDS= "204,1,252,29" HREF= " http : / /proxy . lucidi tygi f t s . com/borders /ht 
tp: / /www. borders .com/ sections /section_2 0000 .html" > 
<AREA SHAPE="rect" ALT= "Video " 

COORDS="253 ,1,2 98,29" HREF= "http : / /proxy . luciditygifts . com/borders/ht 
tp : / /www . borders . com/ sections / sect ion_3 0000. html " > 
<AREA SHAPE="rect" ALT= "NetCaf e " 

COORDS="299, 1, 356, 29" HREF= "http : / /proxy . luciditygifts . com/borders/ht 
tp : / / www . borders . com/netcaf e / index . html " > 
<AREA SHAPE="rect" ALT= " Children ' s " 

C00RDS= "357,1,430,29" HREF= "http : / /proxy . luciditygifts . com/borders /ht 
tp: //www. borders . com/sections/section_40000 . html " > 
<AREA SHAPE="rect" ALT = "Computer Books" 

COORDS="431, 1, 540, 29" HREF= "http: //proxy . luciditygifts . com/borders/ht 
tp: //www. borders . com/sections/section_50000 .html " > 
<AREA SHAPE="rect" ALT= " Shopping Bag" 

COORDS= "541 ,1,574,29" HREF= "https : / /sproxy , lucidi tygi fts . com/borders/ 
https : / /www. borders .com/ cgi-bin/ncommerce3/ExecMacro/shopcart.d2w/report" > 

0 <AREA SHAPE="rect" ALT= " Customer Service" 

COORDS=" 575, 1, 602, 29" HREF= "http : / /proxy . luciditygifts . com/borders /ht 
'Mbp : / /go . borders . com/help/customer-service . xcv?topic=contact&help=contactus 11 > 
^/MAP> 

r<[ — END GNB — > 
"■-4:1 — DATE_TAGLINE . INC — > 

jfj < TABLE BORDER= " 0 " WIDTH= " 100% " CELLSPACING^ " 0 " CELLPADDING= " 0 " > 
<TR> 

?=f <TD BGCOLOR="#f f f fcc"> 

\f\ < TABLE BORDER= " 0 " CELLSPACING^ " 0 " CELLPADDING= " 0 " > 

<TR> 

1 <TD WIDTH="1" HEIGHT= " 2 " BGCOLOR= " #333300 " >< SPACER TYPE= "block" WI 
!%TH="1" HEIGHT="2"x/TD> 

§y <TD WIDTH="145" HEIGHT= " 2 " BGCOLOR= " #0 0000 0 " >< SPACER TYPE="block" 

;jVlDTH= n l n HEIGHT="2"></TD> 

lU <TD WIDTH="8" HEIGHT= " 2 " BGCOLOR= " #cccc99 " >< SPACER TYPE= "block" WI 

njDTH="8" HEIGHT="2"></TD> 

j*s <TD WIDTH="8" HEIGHT="2"xSPACER TYPE= "block" WIDTH="8" HEIGHT= " 2 " 

'5 > </TD> 

!_J <TDx/TD> 
</TR> 
<TR> 

<TD BGCOLOR="#333300"><SPACER TYPE= "block" WIDTH="1" HEIGHT= " 1 " >< / 

TD> 

<TD BGCOLOR=" #000000" VALIGN= " center " ALIGN= " center " xSMALLxFONT 
COLOR= "#f fffff "><B> 

16 Feb 2000 

< / B>< / FONTx / SMALLx /TD> 

<TD BGCOLOR="#CCCc99" VAL I GN= " center " >< SPACER TYPE="block" WIDTH= " 
8" HEIGHT= , '1"></TD> 

<TDx/TD> 
<TDxSMALL> 

Logged in as blholmes 









mummmw 



-.->.>< -mf .>-■-$ - -■ ■■M^te<it>tiwiMi>f'<}l" r y»„< r i\rW<.u% ' f tin?* 

Wed, 16 Feb 2000 23:23:59 diMT 




- <B>Your Info</B> 
</SMALLx/TD> 



</TR> 


















<TR> 


















<TD 


HEIGHT= 




BGCOLOR= 


"#333300 "xSPACER 


TYPE- 


"block" 


WIDTH= "1" 


HE 


IGHT="4"x/TD> 


















<TD 


HEIGHT= 


"4" 


BGCOLOR= 


" #000000 "xSPACER 


TYPE= 


"block" 


WIDTH="1" 


HE 


IGHT="4"x/TD> 


















<TD 


HEIGHT= 


-4" 


BGCOLOR= 


" #cccc9 9 " xSPACER 


TYPE= 


"block" 


WIDTH= " 1 " 


HE 


IGHT="4"></TD> 


















<TD 


HEIGHT= 


» 4 " 


COLSPAN= 


" 2" >< SPACER TYPE= 


'block 


" WIDTH 


="1" HEIGHT^" 


4"></TD> 


















</TR> 


















</TABLE> 



















</TD> 
</TR> 
<TR> 



<TD BGCOLOR=" #000000 "> 

< TABLE BORDER= " 0 " CELLS PAC ING= " 0 " CELLPADDING= " 0 " > 
<TR> 

<TD WIDTH="1" HEIGHT= " 1 " BGCOLOR= " #3 333 00 " xSPACER TYPE= "block" WID 
TH="1" HEIGHT="l"x/TD> 
</TR> 
</TABLE> 
</TD> 
O </TR> 
</TABLE> 

k %kl— COLUMN-LEFT- START . INC — > 

3 £ <TABLE BORDER= " 0 " WIDTH= 11 100% " CELLS PAC ING= " 0 " CELLPADDING= " 0 " > 
<TR> 

<TD BGCOLOR="#f f f f f f "> 
ijl < TABLE B0RDER= " 0 " CELLSPACING= " 0 *' CELLPADDING= " 0 " > 

'f^ <TR> 

^ <TD WIDTH="1" BGCOLOR="#333300"xSPACER TYPE= "block " WIDTH="1 M HEIG 

!JHT= M l"x/TD> 

, <TD WIDTH="145" BGCOLOR= " #cccc99 " VALIGN= " top " > 

SHOPBAG.INC --> 

|y <A HREF= "http : / /proxy. luciditygif ts . com/borders /http : //go .borders 

1% » com /help /customer- service . xcv" > 

y <IMG SRC=" https : / /www. borders . com/web_images/2/section-nav/commer 

llfce/custservice.gif " ALT = "Customer Service" WIDTH="145" HEIGHT="22" BORDER="0"> 

= 1 </a> 

)Z_ <A HREF= " /borders /https :/ /www. borders . com/ cgi-bin/nc 

\ =bmmerce /ExecMacro / shopcar t . d2w/ report " > 

<IMG SRC= "https : / /www. borders . com/web_images/2/section-nav/commer 
ce/ shopbag.gif " ALT= 11 Shopping Bag" WIDTH- " 145 " HEIGHT="22" BORDER="0"> 

</A> 



<A HREF= 11 /borders /https : / /www . borders . com/ cgi-bin/nc 
ommerce /ExecMacro / logout . d2w/report?thisPage=https : //www. borders . com/cgi-bin/nco 







mmmmmmm" 
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mmerce3 / ExecMacro /your info . d2w/ repor t%3Forder_rn%3D " > 

<IMG SRC="https : //www. borders . com/web_images/2 /section-nav/commer 
ce/l/log.gif " ALT= "Log Out" WIDTH="145" HEIGHT="22" BORDER="0"> 

</A> 



<! — LOGGEDIN- STATUS — > 

<! — begin name ID at left — > 
<TABLE BORDER= " 0 " WIDTH="145" CELLPADDING^ " 0 " CELLSPACING^ 11 0 " > 
<TR> 

<TD C0LSPAN="3" HEIGHT= " 2 " >< SPACER TYPE= "block" WIDTH="1" HEIGHT= " 2 11 >< /TD> 
</TR> 
<TR> 

<TD WIDTH="7"><SPACER TYPE= "block" WIDTH="7" HEIGHT= " 1 " ></TD> 
<TD WIDTH="127"> 
<SMALL> 

<B>Logged in as: <FONT COLOR=" #cc0000 " >blholmes</FONT></B> 



<BRx/SMALL> 
</TD> 

<TD WIDTH="11"><SPACER TYPE= "block" WIDTH="11" HEIGHT= " 1 11 >< / TD> 
</TR> 
<TR> 

Q <TD C0LSPAN="3" HEIGHT= " 4 " >< SPACER TYPE= "block" WIDTH="1" HEIGHT= " 4 " ></TD> 

n </TR> 
^ <TR> 

'~4 <TD C0LSPAN="2" HEIGHT= " 1 " BGCOLOR= " #333300 ">< SPACER TYPE= "block" WIDTH="1 

f? HEIGHT= ,l l"x/TD> 

S <TD WIDTH="ll"x/TD> 

^ </TR> 

n <tr> 

^ <TD COLSPAN="3" HEIGHT= " 4 11 >< SPACER TYPE= "block" WIDTH="1" HEIGHT= " 4 " >< / TD> 

^ </TR> 
Jl </ TABLE > 

<• — end name ID at left — > 



j <! — begin shopping bag status blurb at left — > 

% < table b0rder= " 0 " width= " 145 " cellpadding= " 0 11 cells pacing= " 0 " > 

: <tr> 

J <TD WIDTH="7"><SPACER TYPE= "block" WIDTH="7" HEIGHT= " 1 " ></TD> 

<TD WIDTH="127"> 
<SMALL> 

You have <B>1 item</B> in your shopping bag for a subtotal of <FON 
T C0L0R=" ccOOOO " ><B>$  32 . 50</Bx/FONT> . 
<BR>< / SMALL> 
</TD> 

<TD WIDTH= n ll M ><SPACER TYPE= "block" WIDTH= n ll" HEIGHT= " 1 11 >< /TD> 
</TR> 
<TR> 

<TD C0LSPAN="3" HEIGHT^ " 4 " >< SPACER TYPE= "block" WIDTH=" 1" HEIGHT= " 4 " 

></TD> 

</TR> 
<TR> 

<TD COLSPAN="2" HEIGHT= " 1 " BGCOLOR= " #3 33 3 00 " >< SPACER TYPE= "block" WI 



DTH^'l" HEIGHT= ,, l"x/TD> 

<TD WIDTH= ,, ll ,, x/TD> 
</TR> 
<TR> 

<TD C0LSPAN="3" HEIGHT= " 4 " >< SPACER TYPE= "block" WIDTH="1" HEIGHT= " 4 " 

></TD> 

</TR> 
< /TABLE > 

<! — end shopping bag status blurb at left — > 



<! — LEFT-CUST-SERV — > 

<i — begin name ID at left — > 

<! — end name ID at left — > 
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<!— COLUMN-RIGHT-START — > 
</TD> 

<TD WIDTH="8" BGCOLOR="#ff ffcC'xSPACER TYPE="block" WIDTH="8" HEIGHT= "!"></ TD 




fllllifl^ 




> 

<TD WIDTH= 11 8 " >< SPACER TYPE= "block" WIDTH="8" HEIGHT= " 1 " x/TD> 
<TD VALIGN="top"> 



<TABLE BORDER= " 0 " CELLPADDING= " 0 " CELLS PAC ING= " 0 " WIDTH= " 100% " > 
<TR VALIGN- "bottom" > 

<TD R0WSPAN="5" WIDTH= " 40 6 " ><IMG SRC="https : //www. borders .com/web_images/ 2 
/commerce/10. 0/10. 0e_hd.gif" ALT= "Your Information" WIDTH="406 " HEIGHT="35 ,l x/TD 
> 

<TD WIDTH="100%" HEIGHT="34"x/TD> 
</TR> 
<TR> 

<TD HEIGHT= " 1 " BGCOLOR=" #333333 "xSPACER TYPE="block" WIDTH="1" HEIGHT= " 1 " 

></TD> 

</TR> 
<TR> 

<TD HEIGHT="3"x/TD> 
</TR> 
<TR> 

<TD HEIGHT- 11 1 " BGCOLOR= 11 #3333 33 11 >< SPACER TYPE= "block" WIDTH="1" HEIGHT= " 1 " 

></TD> 

</TR> 
</TABLE> 

Links to your account information are included below. Changes to your Address B 
!3ok will not be saved unless you are logged in. 



<Px/P> 



! ft TABLE B0RDER= " 0 " CELLPADDING= " 2 " CELLS PAC ING= " 0 " BGC0L0R= " #f f f f f f " WIDTH="98%"> 
m <TR BGCOLOR="#CCCC99"> 
]'f <TD> 

lis &nbsp ; <B>Your Profile Information: </B> 

</TD> 
]^ </TR> 
=7</TABLE><BR> 

:-="scP></P> 

!H=TABLE WIDTH= ,, 98%" BORDER= " 0 " CELLS PAC ING= " 0 " CELLPADDING= " 4 " > 

fljkTR> 

i^j <TD> 

:!? <P><BxA HREF= "https : / /sproxy . luciditygif ts . com/borders /https : / /www. borders . 
l=fcom/cgi-bin/ncommerce3/ExecMacro/ordstat .d2w/ report ">Order Status :</Ax/bxbr> 
To check the status of an order. </P> 
<P><BxA HREF= "https: //sproxy. luciditygifts.com/borders/https: / /www. borders .c 
om/cgi-bin/ncommerce3 /AddressForm" >Address Book : < / A>< /B><BR> 

To view, edit, add or delete any shipping addresses in your Address Book.</P 

> 

<PxB><A HREF = "https : //sproxy . luciditygif ts . com/borders /https : / /www. borders . 
com/cgi-bin/ncommerce3 /QcpForm" >Quick Checkout Profile : </Ax/BxBR> 
To create your Quick Checkout Profile. </P> 

<PxBxA HREF= " /borders /https : / /www .borders . com/ cgi-bin/ncommerce/RegisterFo 
rm">Your Profile Information : </AxBR> 

</B>To view or update your profile username or password, 
email or address. </P> 
</TD> 



lllfllll 
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</TR> 
</TABLE> 

<HR SIZE="1" WIDTH="98%" ALIGN= " LEFT " NO S HADE > 



<! — COLUMN- BOTH -END — > 

</TD> 
</TR> 
</ TABLE > 
</TD> 
</TR> 
</ TABLE > 

<! — COLUMN-LEFT -START — > 

< TABLE BORDER= " 0 " WIDTH= " 100% " CELLSPACING^ " 0 " CELLPADDING= " 0 " > 
<TR> 

<TD BGCOLOR="#ff ff ff "> 

<TABLE BORDER= " 0 " CELLS PACING = M 0 " CELLPADDING= " 0 " > 
<TR> 

<TD WIDTH="1" BGCOLOR= "#333 300" >< SPACER TYPE= "block" WIDTH="1" HE I 

GHT="l"x/TD> 

<TD WIDTH="145" BGCOLOR = "#cccc99" VALIGN= 11 top " > 
<! — BACK-TO-TOP — > 

<! — Start back-to-top left side — > 
^ <TABLE WIDTH="145" BORDER- " 0 " CELLSPACING= " 0 " CELLPADDING= " 2 " > 

<TR> 

.g <TD WIDTH= I, 145"> 

1 <SMALL><P>5cnbsp;<A HREF-" /borders /https : / /www. borders . com/ cgi-bi 

'^/ncoimerce3/ExecMacro/yourinfo.d2w/report?Krypto^UgWYjhAe%2FCd7qjrSZo4h3ZVf2d4L 
H^kPTlSbHgQr04Ro^HzlgLPZ5idi5mLjcG95p0LQsq5PI^QyunlgfDpBaqf%2FBdHtb7GvQgr04zeJq9D 
^2iGWpYKV4mOnTEgTqM0S5vChXKAtX4KlTVjYpZaUgcTWIAD7Z0Lo%2F2%2BJeL40SAnjmpR7txKcBTN 
^5ig7cFihEJcal6dJYPBCcrZR6HuECuc%2BWIB5q98ktqcLD0Ve%2FI9Fql5Sb%2FyRAwl74imWnZ6reIy 
Uhf z6BFpoUbrXuBSVonclVlqeQsRyPrC08kbM4nxUtSw%3D#top">Back to top</Ax/Px/SMALL> 

</TD> 
! </TR> 
I- </TABLE> 

l\\ <\ — End GC left side — > 

I He i — COLUMN-RIGHT-START — > 
111 </TD> 

<TD WIDTH="8" BGCOLOR="#f ff fcc"><SPACER TYPE= "block" WIDTH="8" HEI 

':53HT= ,, 1"></TD> 

l-J <TD WIDTH= ,, 8"><SPACER TYPE= "block " WIDTH= " 8 " HEIGHT= " 1 " x / TD> 

<TD VALIGN="top ,l > 

<!-- GLOBAL-FOOTER — > 

<SMALL> 
<P> 

<A HREF="http: //proxy. luciditygif ts . com/borders /http : / /www. borde 
rs . com/ ">Home</A> | 

<A HREF= "http : / /proxy . luciditygif ts . com/borders /http : //www. borde 
rs. com/ sections/ section_10000 .html " >Books</A> | 

<A HREF= "http : / /proxy . luciditygif ts . com/borders /http : //www. borde 
rs.com/sections/section_20000 .html " >Music</A> | 

<A HREF= "http: //proxy . luciditygif ts . com/borders /http : //www. borde 
rs.com/sections/section_30000 .html">Video</A> | 



<A HREF="http: / /proxy . luciditygi fts . com/borders /http : //www.borde 
rs .com/netcafe/ index. html" >NetCafe</A> | 

<A HREF= "http : / /proxy . luciditygi fts . com/borders /http : //www.borde 
rs . com/sections/section_40000 .html ">Children' s</A> | 

<A HREF= "http : / /proxy . luciditygi fts . com/borders /http : //www.borde 
rs . com/sections/section_50000 .html ">Computer Books</A><BR> 

<A HREF="/borders/https: / /www. border s . com/ cgi -bin /ncommerce/ Exec 
Macro/ shopcart.d2w/ report "> Shopping Bag</A> | 

<A HREF= "http : / /proxy . luciditygif ts . com/borders /http : / / search .bo 
rders . com/ f cgi -bin/ db2www/ search/ search. d2w/BookKeyword" >Expert Searches</A> | 

<A HREF= "http: //proxy . luciditygif ts . com/borders /http : //go .border 
s. com/help/customer-service. xcv">Customer Service</A> | 

<A HREF=" /borders /https : / /www. borders . com/cgi-bin/ncommerce/Regi 
sterForm">Your Account</A> 

<BR> 

<A HREF= "http : //proxy. luciditygif ts . com/borders/http : //www.borde 
rsstores . com/ " >Borders Stores< / A> | 

<A HREF= "http : //proxy. luciditygif ts . com/borders/http: //go. border 
s. com/ about .xcv">About Borders . com</A> | 

<A HREF="http: //proxy. luciditygif ts. com/borders/http: //go .border 
s . com/disclaimers .xcv" >Copyright © 1998-2000</A> 

</P> 

<P> 

Borders Online/ Inc. is the authorized licensee of the Borders . c 
i^vm trademark and<BR> 

''Z domain name and the Borders NetCafe trademark. All rights reserv 

%d. 

£ </SMALL> 

'""'4:\— COLIMN-BOTH-END — > 

]~ </TD> 
\J </TR> 
III </TABLE> 
</TD> 
</TR> 
I- </TABLE> 

:??::[-- END-HTML ~ > 
IU </BODY> 
I|k/HTML> 



|3= ! — 

Socket time for this request: -0.0800 
Server time for this request: 0.0900 
— > 
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Tue May 9 18:22:042000 




Listing for Tony Bautts 



<%args> 
$url 

</%args> 
<%init> 

$r->send_cgi_header ( "Location: $url\n\n" ) ; 
</%init> 
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Tue Msy 9 1^2^42000 




<%INIT> 

my ($prepend) = " " ; 

if {grep(/"https\:/, $url) ) { 

$prepend = "https : //sproxy . luciditygif ts . com" 

} 

if <grep(/ A http\:/, $url) ) { 

$prepend = "http://sproxy.luciditygifts.com"; 

} 

$url = url($url, $base)->abs; 
if ($type eq 'area' || $type eq 'a') { 
if ( !grep ( /javascript /i, $url) } { 
$url = 11 $prepend/borders\/$url " ; 

} 

} 

if ($type eq 'form') { 

$url = " $prepend/borders\/$url" ; 

} 

return $pre . $quote . $url . $quote; 



</%INIT> 

<%ARGS> 

$pre=>undef 
i =$ type = >unde f 
"'■jquote=>undef 
u4url=>undef 
■~,|base=>undef 
=i/%ARGS> 



^ j 



do 




<%perl_doc> 

this component is used to send a return payment request to CyberCash CashRegiste 
r 

</%perl_doc> 

<%args> 

$order_id 

$ amount 

</%args> 

<%once> 

use CyberC :: CCMckLib3_2 ; 

use CyberC: : CCMckDirectLib3_2 ; 

use CyberC: :CCMckErrno3_2; 

# Initialize the Global Configuration array in CCMckLib3_2 

# JW - change setting of $ConfigFile variable based on where it will eventually 
reside and confirm giftcat names 

my $C onf igFile; 

if ($ARGS{ giftcat} eq ' charities ') { 

$Conf igFile = ' /home /www/ servers /lucidity/app/lucidityinc-83/mck-cgi/ con 
f /merchant_conf ' ; 
} 

elsif {$ARGS{giftcat} eq 'giftcert'H 

$Conf igFile = ' /home/www/ servers /lucidity/app/lucidityinc-83/mck-cgi /con 
f /shine_conf ' ; 
} 

I my $status = CyberC : :CCMckLib3_2 :: InitConfig ( $Conf igFile) ; 

;H/%once> 
: --4%init> 

my (%result) = CyberC :: CCMckDirectLib3„2 :: S endCC 2 _1 Server ( ' return' , %ARGS) ; 
^return (\%return) ; 
;=*:/%init> 



it i 



^tmmy. ' 91S:22:Q42QbO 




<%init> 

$otburl = "http: //10 .20 . 1 . 53 /process /return_int„vars?u_id=$u__id" ; 
my $req = new HTTP: : Request 'GET', $otburl; 
my $otb_var ; 

my $res = $ua->request ( $req) ; 
if {$res->code eq '200') { 

©pairs = split (A&/, $res->content) ; 
foreach $pair (©pairs) { 

($name / $value) = split (A = /, $pair) ; 
$otb_var{$name} = $ value; 

} 

return $otb_var{ 'balance '} ; 
} else { 

return "HTTP/1. 0 200 OK\nContent-type : text/html\n\n<h2>f atal error 3561100- 
012: unable to reach return_int_vars server, \n" ; 
exit ; 

} 

</%init> 
<%ARGS> 
$u„id=>undef 
</%ARGS> 



<%init> 

my ($fullDate) ; 

$dest_address =~ s/\s+/\, /g; 
chomp ($fullDate = *date x ); 

# Do we want to append/prepend to text at all 

# Create the mail command 

my {$mail_cmd) = "To: $dest_address\nFrom: $reply_to\nSubject : $subject\n"; 
$mail_cmd . = "Reply-to : $reply_to\n" ; 
if ($bounce_to) { 

$mail_cmd . - 11 Bounce- to : $bounce_to\n" ; 

} 

$mail„cmd .= "Error : $f ullDate\n$text\n" ; 
open (SENDMAIL, "| /usr/ lib/sendmail -t" ); 
print SENDMAIL $mail_cmd; 
close (SENDMAIL) ; 

</%init> 
<%ARGS> 

$dest_address=> ' f atalerror@ligif ts . com' 
$text=>'An Error occurred 7 
$subj ect=> ' Error ' . localtime 
$reply_to=> ' tecMligif ts . com' 
$bounce„to=> ' tech@ligif ts .com' 
</%ARGS> 




Ml 




%if ($ct eq 'text/html') { 

<table width=100% bgcolor=\ "#000000\ "xtrxtdxfont color=white>Lucidity HTTP Pr 
oxy — Your requests are currently being proxied. </font></tdx/trx/table> 

%} 

</%INIT> 
<%ARGS> 
$ct=>undef 
</%ARGS> 
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<%INIT> 

mc_suppress_http__header ( 1 ) ; 

my {$l_name, $l__gcn, $l_gce, $l_mm, $l_yyyy, $l_uid, $l_damt) ; 
my $ times tamp = time; 
my $trail_pre; 

if {$ARGS{ 'emethod' } ne " ) { 

$ENV{ ' REQUEST_METHOD ' } = "GET" ; 

} 

my $req; 

$req = new HTTP: : Request $ENV{ ' REQUEST_METHOD ' } , $url; 

# Some sites need a real looking referer. 
#$req->push_header ( "Referer" , $url) ; 

#$req->push_header ( "Authorization" , $ ENV { ' HTT P_AUTHORI Z AT I ON ' } ) ; 

# Proxy True Agent 

#$ua->agent ($ENV{ ' REMOTE_AGENT ' } ) ; 

$ua->agent("Mozilla/4.7 [en] (Xll; U; Linux 2.2.10 1586)"); 
my $res = $ua->request ($req) ; 



# Return the proper response code, 
my $code = $res->code; 

die ("bad return code:$code for $ENV{ 'REQUEST_METHOD' } $url" ) unless $code eq 
^00; 

^ # Convert to absolute references 
"P my $content = $res->content ; 
■J my $base - $res->base; 
|;i/%INIT> 

<% $content %> 

m 

"<%ARGS> 

$url=>undef 
l=s$ua=>undef 
5?jc/%ARGS> 
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<%INIT> 

my $url = $ARGS{lucid_url} ; 

my $replace__link = sub { 

my($pre, $type, $quote, $url, $base) - @_; 

my ($prepend) = "https://sproxy.luciditygifts.com"; 

#if (grep{/"https\: /, $url) ) { 

# $prepend = "https://sproxy.luciditygifts.com"; 
#} 

#if (grep(/ A http\:/ / $url) ) { 

# $prepend = "http://proxy.luciditygifts.com"; 
#} 

my $ul = URI : :URL->new{$url, $base) ; 

$url = $ul->abs; 

#$url = url($url, $base)->abs; 

#if ($type eq 'area' j| $type eq 'a') { 

# if (1 grep {/ javascript/ i, $url) ) { 

# $url = " $prepend/bma\ / $url " ; 

# } 
#} 

#if {$type eq 'form') { 

# $url = "$prepend/bma\/$url" ; 
#} 

$url = " $prepend/bma\/$url " ; 
'•*f return $pre . $quote . $url . $quote; 



■r- my $timestamp = time; 

Si my $trail_pre; 

1= if (grep(/"https\:/, $url) ) { 

]t} $trail_pre = "https://strail.luciditygifts.com"; 
M } else { 

ip $trail_pre = "http://trail.luciditygifts.com"; 



- my $args = mc_comp { ' /shared/utils/makeURI ' , %ARGS ); 
III my $req; 

lZ if ( $ENV{ ' REQUEST_METHOD ' } eq 'POST') { 

TU $req = new HTTP: : Request $ENV{ ' REQUEST_METHOD ' } , " $ur 1 " ; 
I|J $req->content_type ( ' application/x-www-f orm-url encoded' ) ; 

$req-> content ( $args) ; 
IJ } elsif ($args) { 
O $url = "$url?$args" ; 

$req = new HTTP: : Request $ENV{ ' REQUEST_METHOD ' } , $url ; 
} else { 

$req = new HTTP: : Request $ENV{ ' REQUEST_METHOD ' } , $url ; 



# Proxy True Agent 

$lucid_ua->agent ($ENV{ ' REMOTE_AGENT ' } ) ; 

my $res = $lucid_ua->request ( $req) ; 

my $ct = $res->content_type ; 
$r->content_type ($ct) ; 

$r->headers_out->unset ( 'Content-Type' ) ; 
$r->headers_out->set ( ' Content-Type ' => " $ct " ) ; 





# Return the proper response code, 
my $code = $res->code; 
$r->headers_out->add ( ' Code ' => " $code " ) ; 



$ r - > s end_h t tp_he ade r ; 

$m->abort { $code) unless $code eq 200; 

# Convert to absolute references 
my $content = $res->content ; 
my $base = $res->base; 
$content =~ s/ 
( 

< (img | a | body | area | frame | td| input | form] link| script) \b 
[ A >] + 

\b ( ? : src | href | background) 

\s*=\s* 

) 

(?: (*') <[*"]*) " | ('XT']*)' | (r\s>] + ) ) 

/ 

$replace_link~>( $1, lc($2), $3||$5, HTML: : Entities :: decode ($4 | | $6 | | $7) , $base 
) /giex; 

isi my $total_purchase = 0; 

=D # We do absolute paths and disable base hrefs 
$content = ~ s/base href =\ " /basehref =\ " /ig; 

2 h 

SJ # Handle Meta Refresh **** FIX REGEX TO HANDLE ANY DELAY *** 
5 « $content =- s/\ " 0\ ;URL=/ \ " 0\ ; URL=\/bma\ / /g; 
^ = $content =~ s/\ M 3\ ;URL=/\ " 3\ ;URL=\/bma\ //g; 

O 

|f¥:/%INIT> 

"%if ($r->content_type =~ /image/) { 
5 <% $content %> 

else { 
is= <% $content %> 
^ # Pixel Calls 

\lk if (grep(/\<basehref=\"http: \/\/www.bluemountainarts.com\/\"\>/ / $content) ) { 
HI <img src=\ " $trail_pre/l/enter/borders . c om/ma in /$l_uid/$l_damt /pixel . gif \?$ti 
:3nestamp\" width=0 height=0> 
\Jk } 

15 if {grep(/\<TITLE\>Borders. com - Standard Checkout<\/TITLE\>/, $content) ) { 

<img src=\ " $trail_pre/l/ checkout /borders . com/main/ $l_uid/$l_damt /pixel .gif \? 
$timestamp\" width=0 height=0> 
% } 

% if {grep(/<TITLE>Borders.com - Your Receipt<\ /TITLE>/ , $content) ) { 
% if (grep(/BGCOLOR=\ ,, \#FFFFCC\"\>\<B\>Total\<\/B\>\<\/TD\>/ / $content) ) { 
% my ($sa, $sb) = split ( /BGCOLOR=\ " #FFFFCC\ " \>\<B\>Total\<\ /B\>\<\ /TD\>\n\n 

\<TD ALIGN=\ "RIGHT\ " width=70 BGCOLOR- \ " #FFFFCC \ 
"XFONT SIZE=\ ,, 2\ ,, \>\<B\>\$/, $content) ; 
% {$total_purchase, $sb) = split {/ \<\ /B\>/ , $sb) ; 

% $total_purchase =~ s/ //g; 

% } 

<img src=\ " $ trail^pre/1/ approval /borders . com/main/$l_uid/$total_purchase/pix 
el .gif \?$timestamp\ " width=0 height=0> 
%} 
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%} 

<%ARGS> 

$ luc id_ua=>unde f 
</%ARGS> 
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BEGIN CERTIFICATE 

MI IC 9 TCC Al 6 g AwIB Agl DAKVeMAO GCSqGS Ib3 DQEBBAUAMIHEMQswCQYDVQQGEw Ja 
QTEVMBMGAlUECBMMV2VzdGVybiBDYXBlMRIwEAYDVQQHEwlDYXBl IFRvd2 4xHTAb 
BgNVBAoTFFRoYXdO ZSBDb2 5 zdWx0aW5nIGN j MSgwJgYDVQQLEx9DZXJ0 aWZpY2 F 0 
aW9u I FN1 cnZp Y2 Vz I ERpdml z aW9 uMRkwFwYDVQQDExBUaGF3 dGUgU2 VydmVy IENB 
MS YwJAY JKo Z IhvcNAQkBFhdz ZX J2 ZXI t Y2 VydHNAdGhhd3 RlLmNvbTAeFwO SOTEy 
MDExMDIwNTdaFwOwMDEyMTQxMDIwNTdaMIGSMQswCQYDVQQGEwJVUzETMBEGAlUE 
CBMKQ2FsaWZvcm5pYTEWMBQGAlUEBxMNU2FuIEZyYW5jaXNjbzEXMBUGAlUEChMO 
THVj aWRpdHks IEluYy4xG j AYBgNVBAsTEWxl Y2 lkaXR5 Z2 lmdHMuY2 9 tMSEwHwYD 
VQQDExhz cH JveHkubHV j aWRpdHlnaWZ 0 cy 5 j b2 OwgZ 8wDQY JKo Z IhvcNAQEBBQAD 
gY0AMIGJAoGBAL4t0xyGgKDXhFwV+NMNAkUaI4k8w9TbCVIH84IZhyB0hyj3W3wN 
090fG+K+nnoEkKSuf 6Bw9Yu9lTU3HDTef 7 9Wyow0puY88p3zGwg4LH6gcQe0cTN9 
IRBpqJsaNsJNpo3UYUcRDNAP5tt6ja/BVucl7dZcEpacgYrJUYXqJQJzAgMBAAGj 
JTA j MBMGAlUd JQQMMAoGCCsGAQUFBwMBMAwGAlUdEwEB / wQCMAAwDQY JKoZ IhvcN 
AQEEBQADgYEAqf nSisWvsbRRmrtPWj 2cDKJoubOXPz/30f iqMS9MLNIRlfVvr30Y 
iONe6CQsFV^wSZHag+YM/jwS3iULogbaveXVNWl^ 
IkwlAmZrjfRJO17C7XE3yV8smkyITsO6UpexXKa0gcf+6bh2Ij+gnps= 
END CERTIFICATE 



BEGIN CERTIFICATE REQUEST 

MI I B + TCCAWI C AQAwgbgxC z A JBgNVBAY TAl VTMRMwEQ YDVQQ I EwpDYWxp Zm9ybmlh 
MRYwFAYDVQQHEwlTYW4gRnJhbmNpc2NvMRcwFQYDVQQKEw5MdWNpZG10eSwgSW5j 
L j EaMBgGAlUECxMRbHVj aWRpdHlnaWZ 0cy5 j b2 OxITAf BgNVBAMTGHNwcm9 4eS5 s 
d™pZGl0eWdpZnRzLmNvbTEkMCIGCSqGSIb3DQEJARYVamFzb250QGNvbm5lY3Ru 
ZXQuY29tMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQC+LdMchoCgl4RcFf jT 
DQJFGiOJPMPU2wlSB/OCGYcgdIco91t8DdPdHxvivp56BJCkrn+gcPWLvSElNxwO 
3n+/VsqMNKbmPPKd8xsIOCx-f oHEHtHEzf SEQaaibGjbCTaaNlGFHEQzQD+bbeo2v 
wVbn Je 3 WXBKWn IGKyVGF 6 iUC cwl DAQABo AAwDQY JKo Z IhvcNAQEEBQ ADgYEAm9 Fx 
YNy9h0Cz7P9lB0ZMu]^AkvEU2PD4kMgbplFMWw88seFDR/l64Mm 
2IsU/CraYOvATAPEHNWmJ644NpHNrWcnquWksR9zxoVJOf /4bJNP9yUeSS9VHpiv 
KTbCZ0xUQW8al9UwJul9++h3Cul2ow2TlS8ifw4= 
END CERTIFICATE REQUEST 
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<%INIT> 
my ©states 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
=1 { code 
z { code 
J { code 
J { code 
~ { code 
™ { code 
j { code 
=| { code 
1 { code 
i { code 
1 { code 
{ code 
{ code 
{ code 
= { code 
{ { code 
I { code 
j { code 
I { code 
1 { code 
\ { code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 
{ code 



=> 'AL', 
=> 'AK' , 
=> 'AZ', 
=> 
=> 
=> 
=> 
=> 
-> 



' AR ' 
'CA' 
'CO' 
'CT' 
' DE' 
'DC 
=> ' FL ' 
=> 'GA' 
'HI' 
'ID' 
f IL' 
'IN' 



= > 
= > 

= > 



=> 'IA' 
=> 'KS' 
=> 'KY' 
=> 'LA' 
'ME' 
'MD' 
'MA' 
'MI' 
=> ' MN' 
=> 'MS' 
=> 'MO ' 
=> 'MT' 
'NC 
'ND ' 



=> 
=> 
=> 
-> 



=> 
= > 



) 



= > 'NE ' } 
=> 'NV' , 
=> 'NH', 
=> 'NJ', 
=> 'NM', 
'NY' , 
'OH' , 
' OK' , 
'OR' , 
'PA' , 
'RI', 
'SC , 
'SD' , 
' TN' , 
'TX' , 
'UT' , 
'VT' , 
'VA' , 
'WA' , 
'WV' , 
'WI' , 
'WY' , 



name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name 

name : 

name ; 



=> 

-> 

~> 

=> 

=> 

=> 

=> 

=> 

=> 

-> 

-> 

-> 

-> 

=> 

=> 

=> 

=> 

=> 

=> 

=> 

~> 

=> 

-> 

=> 

-> 

-> 

-> 

=> 

=> 

=> 

=> 

=> 

-> 

=> 

=> 



'Alabama' }, 
'Alaska' }, 
'Arizona' }, 
'Arkansas' }, 
'California' }, 
'Colorado' }, 
'Connecticut' }, 
' Delaware ' } , 

'District of Columbia (DC) ' } 

'Florida' }, 

'Georgia' }, 

'Hawaii' }, 

'Idaho' }, 

'Illinois' }, 

' Indiana' } , 

'Iowa' }, 

'Kansas' }, 

'Kentucky' }, 

'Louisiana' } , 

'Maine' }, 

' Maryland ' } , 

' Massachusetts ' } , 

'Michigan' }, 

'Minnesota' }, 

'Mississippi' }, 

'Missouri' }, 

'Montana' }, 

'N. Carolina' }, 

' N . Dakota' }, 

'Nebraska' }, 

' Nevada ' } , 

'New Hampshire' }, 
' New Jersey ' } , 
'New Mexico ' } , 
'New York' } , 
'Ohio' }, 
' Oklahoma ' } , 
'Oregon' } , 
'Pennsylvania' }, 
'Rhode Island' }, 
'South Carolina' } , 
'South Dakota' } , 
'Tennessee' }, 
'Texas' }, 
'Utah' }, 
'Vermont' }, 
'Virginia' }, 
'Washington' }, 
'West Virginia' } , 
'Wisconsin' }, 
' Wyoming ' } , 



return { Estates ), 
</%INIT> 



<%init> 

return unpack {'H*', $old) ; # Can return huge string 

</%init> 

<%args> 

$old 

</%args> 
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Listing for 1 
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# ! /usr/bin/perl 

use HTML: : Ma son; 
use strict; 

my $outbuf; 

my $parser = new HTML: : Mason :: Parser ; 

my $interp = new HTML: : Mason :: Interp ( parser=>$parser , 

comp_root=> ' /home/www/comps/shared/utils ' , 
data_dir=>' /home/ www/mason/ shared/uti Is ' , 
out_method=>\$outbuf } ; 

my $retval = $interp->exec { ' /unique_id.new' ); 

open{ F, "mason. out" ); 
print F $outbuf; 
close (F) ; 

print "return value of component was: $retval\n" ; 
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<%ONCE> 

use LWP: :UserAgent; 
use HTTP; : Request; 
</%ONCE> 
<%INIT> 

my $ua = new LWP: :UserAgent; 

$ua->agent ( "Mozilla/4 . 7 [en] (Lucidity)"); 

$ ua-> timeout (20 } ; 

my $req = new HTTP: : Request ' GET ' , "https://www.borders.com"; 

my $bma_res = $ua->request ( $req) ; 

</%INIT> 

<% $bma„res->code %> 
<% $bma_res->content %> 




# ! /usr/local/bin/perl 

use LWP : : User Agent ; 
use HTTP: : Request; 

my $ua = new LWP: :UserAgent; 

$ua->agent ( "Mozilla/4 . 7 [en] (Lucidity) " ) ; 

$ua->timeout (20 ) ; 

my $req = new HTTP: : Request 'GET', "https://www.borders.com"; 
my $bma„res = $ua->request ( $req) ; 
print $bma„res->code; 
print $bma_res->content ; 



if 




<%doc> 

Process to generate unique UIDs . This algorithm will continue to work properly u 
ntil the year 2587 :} 

Based on GMT time and the process ID number ($$} 

</%doc> 

<%init> 

my ( $ID, $hex ) ; 

my( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = gmtime ( time ( ) ) ; 
my $rand = int (rand { 10 ) ) ; 

# create ID based on date information and process number 

# $yday = day of the year (0-365); $yday+l to get the more familiar 1-366 

# $year is years since 1900 (3 digits) 

# $msec = seconds since midnight (5 digits, since it's at most 86400) 
my $msec = ($hour*3600) + ($min*60) +$sec; 

my $num = sprintf( ,, %03d%03d%05d ,, , $year , $yday+l , $msec ); 

# Convert to hex to compress number from 11 to 9 characters while keeping it uni 
que 

# (hex function produces overflow so this is done explicitly) 
my $test = sprintf( "%9x",$num ); 

my { $i ) ; 

"Siy $temp = $num; 
^l&hile{ $temp >= 16 } { 
■J $temp = $ temp/ 16; 
~ $i++; 

;4 

=5while( $i>=0 ) { 

111 mv $ ex P = 16** $i; 

0 my $value = int { $num/$exp) ; 
m if( $value == 10 ) { 

$ value = ' A' ; 

1 } elsif { $value == 11 ) { 
l^z $value = 'B' ; 

\ n } elsif ( $value == 12 ) { 
z -'^ $value = ' C ; 

ill } elsif ( $value == 13 ) { 
lit $value = ' D' ; 

!I? } elsif ( $value == 14 ) { 
IJ $value = 'E' ; 

O } elsif ( $value == 15 ) { 
$ value = ' F ' ; 

} 

$hex = $hex . $value; 

$num = $num - ($exp*$value) ; 

$i — ; 

} 

while ( length ($hex) < 9 ) { 
$hex = '0' . $hex; 

} 

# Add PID and a random number 

$ID - sprintft "%09d%05d%01d" ,$hex, $$,$rand ); 



mm:*:;; 
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return $ID; 
</%init> 
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<%doc> 

borrowed code from CyberCash to generate unique id's 

based on GMT time and the process ID number {$$) 

</%doc> 

<%init> 

my($ID) ; 

my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime ( time ( ) ) ; 

# create ID based on date, time, and process number 

# $mon is the month index where Jan=0 and 060=11, so we use 

# $mon+l to get the more familiar Jan=l and Dec=12 

# $year is years since 1900: we want only two digits 

$ID = sprintf { " %02d%02d%02d%02d%02d%05d" , $year % 100, $mon+l , $mday , $hour , $min, $ 
$); 

return $ID; 
</%init> 
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<%doc> 

borrowed code from CyberCash to generate unique id's 

based on GMT time and the process ID number ($$} 

</%doc> 

<%init> 

my($ID) ; 

my ($360, $min, $hour, $mday, $mon, $year , $wday, $yday, $isdst) = gmtime ( time { ) ) ; 

# create ID based on date, time, and process number 

# $mon is the month index where Jan=0 and Dec=ll, so we use 

# $mon+l to get the more familiar Jan=l and Dec=12 

# $year is years since 1900: we want only two digits 

$ID = sprintf ( "%02d%02d%02d%02d%02d%05d" , $year % 100, $mon+l, $mday, $hour , $min, $ 
$); 

return $ID; 
</%init> 




%foreach my $key (keys %ARGS) { 

<% $key %>=<% $ARGS{$key} %><BR> 



<%args> 

$old 

$fname 

$of fset 

</%args> 

<%init> 

my ($key) ; 

open (KEY, $fname) or die "Cannot open $fname: $1"; 
seek(KEY, $of f set, 0} ; 
read(KEY, $key, 256); 
close KEY; 

return substr ($old A $key, 0, length $old) ; # Assumes length $old <= length $ke 

y 

#return substr {$old " $key, 0, (length $old < length $key) ? length $old : leng 

th $key) ; # More robust 

</%init> 
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<%PERL_ARGS> 
$f irst_year=> ' ' 
$how_many=> '20' 
$selected=>' ' 
$name=> 'year ' 
</%PERL_ARGS> 
<%PERL_INIT> 

$first_year = 1999; # Replace with call to get year... 

</%PERL_INIT> 

<SELECT NAME="<%$name%>"> 

<OPTION VALUE = " " >Year 
% f or { my $year=$f irst_year ; $year< { $f irst_year+$how_many) ; $year++ ) { 
% if ( $selected == $year ) { 

<OPTION VALUE= n <%$year%>" SELECTEDx%$year%> 
% } else { 

OPTION VALUE= "<%$year%> " ><%$year%> 

% } 
% } 

</SELECT> 
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% if (defined ($process) ) { 

% (%missing) = mc_cornp { ' add_validate ' , %ARGS) ; 

% unless ( $missing{ status } ) { 

% if ($process eq "CONFIRM") { 

<& add_send, %ARGS &> 
% $called = "add_send n ; 

% } elsif ($process eq "INFO") { 

% $ARGS {process } = "CONFIRM" ; 

% $called = "add_conf irm" ; 

<& add_template, %ARGS , top=>l&> 

<& add_confirm, %ARGS &> 

<& add_template, %ARGS, bottom=>l&> 

% } 

% } else { 

% $called = "add_info: $process"; 

<& add_template, title=>'Add Funds to Your Bluemountain Gold', %ARGS , t 

op->l&> 

<Sc add_info, missing->\%missing, %ARGS &> 
<Sc add_ template, %ARGS, bottom=>l&> 

% > 
%} else { 

% $called = "add_info no process"; 

<& add_template, title=>'Add Funds to Your Bluemountain Gold', %ARGS, top=> 

1$C> 

<& add_info, %ARGS &> 

<& add.template, %ARGS, bottom=>l&> 

~|<%INIT> 

l!$ARGS{giftcat} = 'giftcert'; 
^$ARGS{card_number} s/[ A \d]+//g; 

=J$ARGS{order_id} = mc_comp ( ' /shared/utils /unique_id' ) unless $ARGS{order_id 

^$ARGS{u_id} = $ARGS{uid} unless $ARGS{u_id>; 

Sunless ($ARGS {balance}) { 

S my (%data) = mc_comp ( 'user_lookup' , u_id=>$ARGS{u_id} ) ; 

* 3 $ARGS {balance} = $data {balance } ; 
} 

^if ($ARGS{damt} ! $ ARGS { amount } ) { 

$ARGS{ amount} = sprintf '%.2f, $ ARGS {damt } -$ARGS { balance } ; 

U ) 

y $ ARGS { amount } =- s/ [ A \d\ . ] +//g; 

s=my %missing; 
Jmy $called; 

: 3</%INIT> 
: ~"<%ARGS> 

$process=>undef 

</%ARGS> 

<! — 

Called <% $called %> 

% for each my $key (sort keys(%ARGS)) { 
% my $value = $ARGS{$key} ; 

Key: <%$key%> Value: <%$value%> 

% } 

% foreach my $key (sort keys (%mis sing) ) { 
% my $value = $missing{$key} ; 

Missing Key: <%$key%> Value: <%$value%> 

% ) 



% if {defined ($process) ) { 

% (%missing) = mc_comp ( ' add_validate ' , %ARGS) ; 

% unless ( $missing{ status } ) { 

% if ($process eq "CONFIRM") { 

<& add_send, %ARGS &> 
% $called = "add_send"; 

% } elsif ($process eq "INFO") { 

% $ARGS {process} = "CONFIRM" ; 

% $called = "add_conf irm" ; 

<& add_template, %ARGS , top=>l&> 

<& add_confirrn, %ARGS &> 

<Sc add__template, % ARGS , bottom=>l&> 

% } 

% } else { 

% $called = "add„info: $process"; 

<& add_template, title=>'Add Funds to Your Bluemountain Gold' %ARGS , t 

op=>l&> 

<& add_info, missing=>\%missing, %ARGS &> 
<& add_template, %ARGS, bottom=>l&> 

% } 
%} else { 

% $called = "add_info no process"; 

<& add_template, title=>' Add Funds to Your Bluemountain Gold', %ARGS . tov=> 

lSc> * 

<Sc add„info, %ARGS &> 

<& add_template, %ARGS, bottom=>l&> 

^J<%INIT> 

«$ARGS{giftcat} = 'giftcert'; 

=h$ARGS{card_number} =~ s/[ A \d]+//g; 

: 'y$ARGS{order_id} = mc_comp ( ' /shared/utils/unique_id' ) unless $ARGS { order__id 
= ^ ' 

Jfj$ARGS{u_id} = $ARGS {uid} unless $ARGS{u„id}; 
|_Junless ( $ARGS {balance } ) { 

in my (%data) = mc_comp ( 'user„lookup ' , u_id=>$ARGS{u__id} ) ; 

$ARGS {balance} = $data{balance} ; 

2 } 

fs&if ($ARGS{damt} J $ ARGS {amount } } { 

i|j $ARGS{amount} =sprintf '%.2f, $ARGS { damt } -$ARGS { balance } ; 

! !l$ARGS { amount } =- s/ [ A \d\ . ] +//g; 

Ifimy %missing; 
!3ny $ called ; 

h</%init> 

'^<%ARGS> 

$process=>undef 
</%ARGS> 

< ! — 

Called <% $called %> 

% foreach my $key (sort keys{%ARGS)) { 
% my $value = $ARGS{$key} ; 

Key: <%$key%> Value: <%$value%> 

% } 

% foreach my $key {sort keys { %missing) ) { 
% my $value = $missing{ $key} ; 

Missing Key: <%$key%> Value: <%$value%> 

% } 



<TABLE BORDER=0 BGCOLOR= " #66CCFF " CELLSPACING=0 CELLPADDING=4 WIDTH=700>< 1FFFFCC 
<TR> 

<TD VALIGN=middle BGCOLOR="#66CCFF" ALIGN=center valign=top> 
<FONT SIZE=5 COLOR="#000000"> 

To proceed, <b>click on submit ! </b> 

You will be e-mailed a receipt, 
%if ($store) { 

and you will be returned to the store complete your check-out. 

% } 

Enjoy your Blue Gold! 

%# Evil Here now: 

% foreach my $key {keys %ARGS) { 

% if ($key eq 'process') { 

<INPUT TYPE= n hidden" name =" pro cess" value= " CONFIRM 11 > 
% } else { 

<INPUT TYPE=" hidden" name= "<%$key%> " value= " <%$ARGS { $key} %> " > 
% } 
% } 

</font> 
<p> 

<b> <INPUT TYPE=image src=" /images/gif tcard/submitbutt .gif " Name=" submit "></b><b 
r> 

^<font size=3>It may take up to a minute to process your transaction. </font> 
~<center>or<br> 

y<a href =" javascript : history. go (-1) ">go back and edit your order</a> 
j<p> <px/center> 

F</TD> 
J</TR> 

fJ<TR> 

J<TD align=left bgcolor=66CCFF>  <br> 

fi<p>&nbsp ; <p>< / cent er > 

= "</FORM> 



ss<font size=2xi>Terms of Service :<br> 

;»Blue Mountain Gold is brought to you by Bluemountain in partnership with Lucidit 
yy Gifts. 

yOnce you submit, the recipient will be sent an e-mail notification, and will rec 
.reive a 

^subsequent reminder if he/she forgets 

jto view the card. You will receive an e-mail receipt. In 3 weeks if the recipien 

has not yet viewed the card, you will receive an alert in your e-mail. 

If the recipient does not pick up his/her gift certificate, you may request a re 

fund. 

<b> 

You will be able to view and use your certificate for 6 months. 
</b> <br> 

<centerxfont size=lxi>if you have questions, you may e-mail <a href =mailto: Sup 
port@BluemountainGif ts . com> 

Support@BluemountainGif ts . com</a> . < /center > 
</b> 
</font> 
</ TABLE > 



<%ARGS> 

$store=>undef 

</%ARGS> 



<CENTER> 

% if {$missing{ status} ) { 

The starred fields (<%$star%>) must be supplied... 

% } 

< TABLE BORDER- 0 CELLPADDING= 3 CELLSPACING=0> 

<INPUT TYPE= " hidden " NAME= "process" VALUE= " <%$process%> " > 

<INPUT TYPE= 11 hidden " NAME= "u__id" VALUE= " <%$u_id%> " > 

<INPUT TYPE- "hidden" NAME= " gif teat " VALUE= "<%$ARGS{ ' gif teat ' } %> "> 

<INPUT TYPE="hidden" NAME= " type " VALUE= "<%$ARGS{ ' type ' }%>"> 

%# No Loc at this point. <INPUT TYPE= "hidden" NAME= M LOC" VALUE= "<%$ARGS 

{ 'LOC '}%>"> 

<INPUT TYPE= " hidden " NAME= " store " VALUE="<%$ARGS{ ' store' }%>"> 

<INPUT TYPE= "hidden" NAME= " returnur 1 " VALUE= M <%$ARGS{ ' returnurl ' } %> "> 
<INPUT TYPE="hidden" NAME = "balance " VALUE- "<%$ARGS{ 'balance '}%>"> 

<INPUT TYPE=" hidden" NAME=" ordered" VALUE="<%$order_id%>"> 

<TR> 

<TD C0LSPAN= ,, 8" ALIGN= " center " > 
<FONT SIZE="5"> 

<% $missing{ ' amount ' } %> 
Enter <B>Amount to Add:  

$< INPUT NAME= " amount " TYPE="text" SIZE="7" MAXLENGTH- " 7 " VALUE="<%( $amo 
unt ? $amount : '20.00' )%>"></B> 
|*t </FONT> 

<FONT SIZE="2"><I> (any amount between $0.01 and $500 . 00) </Ix/FONT> 
</TD> 
p </TR> 

<TR> 

i?s <TD COLSPAN=8> </TD> 
!~ </TR> 

j f| <TR> 

<TD><% $missing{ ' card_f irst_name ' } %><B>Your</B> First Name:</TD> 
5 <TD> 

<INPUT TYPE="text" NAME="card_f irst_name" SIZE=30 MAXLENGTH=25 VALUE="<% 
s= =$card_f irst„name%> " > 
!! J </TD> 
III </TR> 

]Z <TR> 

M <TD><% $missing{ ' card_last_name ' } %>Your Last name:</TD> 

O <TD><INPUT TYPE=text NAME= 11 card_las t_name " SIZE=30 MAXLENGTH=2 5 VALUE="<%$ca 
rd_last_name%> 11 >< /TD> 
</TR> 

<TR> 

<TD><% $missing{'to_ernail'} %>Your E-Mail Address : </TD> 
<TD> 

% if( $to_email && I $missing{ ' to_email ' } ) { 

< I >< % $ t o_emai 1 %>< / 1 > 

<INPUT TYPE=hidden NAME= " to_email " VALUE= " <%$to_email%> " > 
% } else { 

<INPUT TYPE="text" NAME="tO_email" SIZE=50 MAXLENGTH = 5 0 VALUE= " <%$tO ema 
il%>"> ~~ 
% } 

</TD> 




</TR> 

<TR><TD C0LSPAN=2xB>Credit Card Information</Bx/TDx/TR> 
<TR> 

<TD C0LSPAN=2 ALIGN=middle> 

<TABLE BORDER=0 CELL PADDING = 3 CELLSPACING=0> 
<TR> 

<TD WIDTH=20x/TD> 

<TD><% $missing{ 'card_type' } %>Credit Card Type:</TD> 

<TD C0LSPAN=7> 

<%mc_comp{ ' /shared/interface/dropdown/credit_card' , name ->' car d_typ 
e', selected=>$card_type, gif tcat=>$ARGS { ' gif teat ' } ) %> 
</TD> 
</TR> 

<TR> 

<TD WIDTH=20x/TD> 

<TDx% $raissing{ ' card_number ' } %>Credit Card number:</TD> 
<TD C0LSPAN=7> 

<INPUT TYPE^text SIZE=20 NAME= " card_number " VALUE = " <%$card number%>" 
MAXLENGTH=20> ~ 
</TD> 
</TR> 

™ <TR> 

*U <TD WIDTH=20></TD> 

•J, <TD><% $missing{ ' card_exp_month' } %><% $missing{ ' card_exp_year ' } %>Exp 

^iration date:</TD> 
+ <TD C0LSPAN=7> 

^ <& /shared/interface/dropdown/month, name=> ' card_exp_month ' , selected 

§fp>$card_exp_month &> 

]~ <& /shared/ interface /dropdown /year , name=> 'card_exp_year ' , selected 

= =J=>$card_exp_year &> 

m </td> 

</TR> 

IsS: <TR> 

hi <TD WIDTH=20x/TD> 

\'f s <TD COLSPAN=8> 

^ <B>Billing address</B> - Please supply the billing address for this 

lycredit card: 

I'Z </TD> 

M </TR> 

<TR> 

<TD WIDTH=2 0x/TD> 

<TD><% $missing{ 'company' } %>Company : </TD> 

<TD C0LSPAN=7>< INPUT NAME =" company" SIZE=30 MAXLENGTH= 5 0 VALUE= "<%$com 
pany % > " >< / TD> 
</TR> 

<TR> 

<TD WIDTH=20x/TD> 

<TD><% $missing{ 'card_street ' } %>Street : </TD> 

<TD COLS PAN= 4 >< INPUT NAME= 11 car d__s tree t " SIZE=30 MAXLENGTH= 4 0 VALUE="<% 
$card_street%>"x/TD> 



vMtf'r:'- ;f»(p/f^ : ' ! -0^m.' w%\k- yMv f i^r 



:=? :::: ' ' :-w- m * ■ tmiffi-^^'^ '^m^^^mi**' ^mB^ 




<TD WIDTH=10x/TD> 

<TD><% $missing{ 'card_apt ' } %>Apt #:</TD> 

<TD>< INPUT NAME="card_apt" SIZE=6 MAXLENGTH=5 VALUE= " <% $card apt%>"></ 

TD> 

</TR> 
<TR> 

<TD WIDTH=20x/TD> 

<TD><% $missing{ ' card^city' } %>City:</TD> 

<TD>< INPUT NAME="card_city" SIZE=20 MAXLENGTH=2 0 VALUE= "<%$card„city%> 



<TD WIDTH=10></TD> 

<TD><% $missing{ 'card_state' } %>State : </TD> 

<TD>< INPUT NAME="card_state" SIZE=3 MAXLENGTH= 2 VALUE= " <%$card_state%> 



<TD WIDTH=10x/TD> 

<TD><% $missing{ ' card_zipcode ' } %>Zip Code:</TD> 

<TD>< INPUT NAME="card_zipcode" SIZE=10 MAXLENGTH= 1 0 VALUE= " <%$card_zip 
code%>"x/TD> 
O </TR> 

*y <tr> 

■y <TD WIDTH=2 0x/TD> 

p <TD><% $missing{ 'card_country' } %>Country : </TD> 

: f : <TD C0LSPAN=7>< INPUT NAME= " card_country " SIZE=16 MAXLENGTH=3 2 VALUE="< 

'M% ($card_country ? " $card_country " : 'USA' ) %>"x/TD> 
Iff </TR> 

M <TR> 

s|l <TD WIDTH=20x/TD> 

<TD C0LSPAN=8xB>Phone number</B> - associated with the billing addres 

; S</TD> 

I s * </TR> 

<tr> 

\^ <td width=20></td> 

<td c0lspan=9> 

<% $missing{ ' area_code ' } %>Area: 
U <INPUT NAME="area_code" SIZE=4 MAXLENGTH= 3 VALUE="<%$area_code%>"> 

&nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; 
<% $missing{ 'phone 7 } %>Phone #: 

<INPUT NAME= "phone " SIZE=10 MAXLENGTH= 8 VALUE = " <%$phone%> " > 
&nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; 
<% $missing{ ' ext ' } %>Ext: 

<INPUT NAME- " ext " SIZE=5 MAXLENGTH= 6 VALUE= " <%$ext%> " > 
</TR> 
</TABLE> 

</TD> 
</TR> 

<TR> 

<TD C0LSPAN=8> </TD> 



"></TD> 



"></TD> 




</TR> 

</TABLExcenterxfont size=5 face=arial, helveticaxb> 

<INPUT TYPE=image src=<% $image_base %>/continuebuttc . gif border=0 NAME= 11 submit 11 
> 

</bx/fontxbr> 
</CENTER> 

<font size=2 f ace=arial, helvetica><i>continuing will bring you to a purchase con 
f irmation page</ix/f ontx/centerxp> 
&nbsp ; <br> 

<font size=2 f ace=arial , helve tica>&nbsp ;           &nbsp ; &nbs 
p ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nb sp ; &nbsp ; 

&nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbs 
p ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; 

&nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; tobsp ; &nbsp ; &nbsp ; &nbs 
p ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; 

&nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbs 
p ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; 

&nbsp ; fcnbsp ; &nbsp ; &nbsp ; &nbsp ; knbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbs 
p ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; 

fcnbsp ; fcnbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbs 
p ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; 

&nbsp ; &nbsp ; &nbsp ; &nbsp ; knbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; &nbsp ; 

<a href= ,, http://www.luciditygifts.com/giftcard/<%$ARGS{ ' type' }%>/he 
p|lp/policies.html">privacy and security statement</a> 
"S</center> 

'y<%ARGS> 
~^%mi s s ing=>undef 
'\$u_id=>' ' 
: ^j$uid=>' ' 
I fl$order_id=> ' ' 
- : I^$to_email=> ' ' 
^$to_name=> ' ' 
^Fi$card^type=> ' ' 

$card_number=> ' ' 
I $card_exp„month=> ' ' 
|^$card_exp_year=> ' ' 
§y$carcL_f irst_name=> ' ' 
l^$card_last_name=> ' ' 
i y$ company => ' ' 
fU$card w street=> ' ' 
Ji$card_apt=> ' ' 
^$card_city=> ' ' 
0$card_state=> ' ' 

$card_zipcode=> ' ' 

$card__country=> ' ' 

$area_code=> ' ' 

$phone=>' ' 

$ext=>' ' 

$ amount =>' ' 

$damt=> ' ' 

$EF=>' ' 

$NF=> ' ' 

$ET=>' ' 

$NT=> ' ' 

$process=>" INFO " 

</%ARGS> 

<%INIT> 



my $star = "<FONT COLOR=red>*</FONT> " ; 

# Translate BMA variables into Lucidity variables if supplied 



$to_email = $EF unless $to_email; 

$to_name = $NF unless $to_name; 

$u„id = $uid unless $u_id; 

$card_f irst_name - $to_name unless $card_f irst_name; 

my $image_base = "https://fund.luciditygifts.com/images/giftcard 11 ; 

</%INIT> 



<HTML> 
<HEAD> 

<TITLE>Blue Mountain Gold Page</TITLE> 
%# <META http-equiv=" refresh" content="15, url=http: / /www. luciditygif ts . com/gif 
tcard/balance?LOC=<% $LOC %>&type=<%$type%>"> 
</HEAD> 

<BODY BGCOLOR= " # f f f f f f " BACKGROUND= " / imag e s / char i ty / c 1 oudsjog . g i f " > 
<center> 

< TABLE bgcolor=#f f f f f f border="0" CELLPADDING= " 0 11 CELLSPACING= " 0 " WIDTH="700"> 

<trxtd align=rightximg src=/images/gif tcard/barrelscriptxt . gif > 

</tdxtd align=centerxfont size=4>Congratulations ! Your Blue Mountain Gold<font 

size=2> (tm)<font size=4> gift certificate has been updated) <% $amount %> has 
beed added to your account<f ontx/td> 

<td align=lef tximg src=/ images/gif tcard/barrelscriptxt . gif ></td></tr></ table> 

<table width=100% bgcolor=#99ccf f cellpadding=0 cellspacing=0> 

<tr> 

<td align=center> 

You may continue shopping. Your current total is $<% $balance %><BR> 
You will be e-mailed a receipt. Thank you.<br> 

<font size=2xi>If you have questions about Blue Mountain Gold, please visit 
the <a href =http: //www. luciditygif ts . com/charity/helpcenter/> 

Blue Mountain Gold support page</a>, or e-mail <a href =mailto : inf o@lucidityinc . c 
om> 

inf o@lucidityinc . com</a></i> 
E~K/tdx/trx/table> 

i; U%if ($returnurl) { 

SJ%$returnurl = uri_escape ( $returnurl , " A A-Za-zO-9 " } ; 

=^%#<Pxa HREF= "http : / /www. luciditygif ts . com/gif tcard/mall?LOC=<% $LOC %>&returnur 
"r%-<% $returnurl %>" TARGET= "mw" > Continue Shopping</A><P> 
%*%#<PxA HREF="<% $returnurl %>" TARGET^ 'mw' >Continue Shopping</AxP> 

in*} 

:L:<PxA HREF=" javascript : self .close () " >Close</AxP> 
ffk i — 

* % for each my $key (keys %ARGS) { 
s <% $key %> => <% $ARGS{$key} %><BR> 

} 

l^U/BODY> 
I y</HTML> 
lfj<%ONCE> 

J^use URI: : Escape; 

^f</%ONCE> 

l~H%INIT> 

$balance = sprint f "%.2f", $balance+$amount ; 

</%INIT> 

<%PERL_ARGS> 

$LOC=> ' ' 

$u_id=>' ' 

$amount=>' ' 

$balance=>' ' 

$order_id=>' ' 

$type=>'kids ' 

$ r e t ur nur 1 = >unde f 

</%PERL_ARGS> 



<%doc> 

Make the call to charge and return data 
Will display a frame set on success. 

an error page with key/val pairs for any problems 

</%doc> 
<%once> 

use URI:: Escape; 

</%once> 

<%init> 

my{ %data, $inf o__string ) ; 

# Call to app server to charge the card # 

mc_comp(' /shared/utils/inf o_string' , %ARGS, STORE=>\$inf o_string) ; 
my $giftcard = "10.20.1.53"; 

my $url = "http: //$gif tcard/process/charge?$inf o_string" ; 

# Get ^he based on the u_id. Need these to redirect back to m 

all # 

my $L0C = mc_comp( 'get_L0C, u_id=>$u_id ); 
$LOC =- s/\s+//g; 

# Set various URLs # 

;^|ny $return = mc_comp { ' /shared/http/lwp_call ' , url=>$url, timeout=>90, retry=>l 
~;Z, data=>\%data) ; 

'^unless ($returnurl) { 
g# my $trailp = "10.20.1.54"; 

"™# my $trail„ret = mc„comp {' /shared/ http/ lwp_c all ' , 

'^J# url=>"http : //$trailp/push/get_last_request?u_id=$u_id" , timeout=>10, ret 

| ffry=>3 , 

)lz# data=>\$returnurl) ; 

^# chomp ($returnurl) ; 

I </%init> 

|| =%±f {$return != 200 || $data{success} == 0) { 
ITz <& error_template, %ARGS, %data, top=>l&> 

<& error, %ARGS, %data, return=>$return, url=>$url, error_id=>$inf o_string 

<& error_template, bottom=>l&> 

return 1; 
jj3%} elsif ($data{success} == 3) { 
% my (%missing) ; 
% $missing{ status} = 1; 

% $missing{card_number} = " <F0NT COLOR=red>Your Card was declined, please try 
another card. </FOWT>" ; 

<& add^template, %ARGS , %data, top=>l&> 

<& add_info, missing=>\%missing, %ARGS &> 

<& add„template, %ARGS, %data, bottom=>l&> 
% return 1; 

%} elsif ($data{success) == 2) { 

% $ARGS{ queue} = 1; 

%} elsif ($data{success} == 4) { 

% $ARGS{duplicate} = 1; 

%} 



ill 



■m 




<& 'add_waiting' , %ARGS, LOC=>$LOC &> 
%# <& 'add_receipt' , %ARGS , LOC=>$LOC &> 
%# <%$refresh_url%> 

<%ARGS> 

$ r e tur nur 1 = >unde f 
$type=> 'kids' 
$u__id=>undef 
</%ARGS> 



<%doc> 

Make the call to charge and return data 
Will display a frame set on success . 

an error page with key/val pairs for any problems 

</%doc> 
<%init> 

my( %data, $info_string ); 

# Call to app server to charge the card # 

mc_comp{ ' /shared/utils/info_string' , %ARGS / STORE=>\$inf o_string) ; 
my $giftcard = "10.20.1.53"; 

my $url = "http : //$gif tcard/process/charge?$inf o_string" ; 

# Q et the log based on the u_id. Need these to redirect back to m 

all # 

my $L0C = mc_comp( 'get_L0C', u_id=>$ARGS{ 'u_id' } ); 
# Set various URLs # 

my $return = mc_comp ( ' /shared/http/lwp_call ' , url=>$url, timeout=>90 , retry=>l 
, data=>\%data) ; 

my $receipt = "https : //secure . luciditygif ts . com/gif tcard/add_receipt?$inf o_stri 
ng&LOC=$LOC" ; 

s=fny $mall_url = "http: //www. luciditygif ts . com/gif tcard/mall_shops?LOC=$LOC" ; 

-•LJ$receipt =~ s/\s//g; 

^j$mall__url =- s/\s//g; 

s H</%init> 

sJfcif ($return != 200 || $data{success} == 0) { 
:t: <& error_template, %ARGS , %data, top=>l&> 

\J <& error, %ARGS, %data, return=>$return, url=>$url, error_id=>$inf o_string 

if&> 

<& error_template, bottom=>l&> 
5 % return 1; 

f=l%} elsif ($data{success} == 3) { 

i%& NY (%niissing) ; 

Jj^ $missing{status} = 1; 

|L% $missing{card_number} = "$tag„start Your Card was declined, please try anot 
fsjier card. $tag_end"; 

%2 <& add_template, %ARGS, %data, top=>l&> 
^ <& add_info, missing=>\%missing, %ARGS &> 

Q <Sc add_template, %ARGS , %data, bottom=>l&> 
% return 1; 

%} elsif ($data{success} == 2) { 

% $ARGS{ queue} = 1; 

%} elsif ($data{ success} == 4) { 

% $ARGS {duplicate} = 1; 

%} 

<SCRIPT LANGUAGE= " JavaScript " > 
< ! — 

/ / Reload top frame with receipt 

parent . frames [0] .location. href = "<% $receipt %>"; 
//--> 
</SCRIPT> 



% if( $returnurl ) { 



<SCRIPT LANGUAGE = " JavaScript " > 
< ! — 

//Reload this frame with return URL 
parent . frames [1] . location, href = "<%$returnurl%> " ; 
// — > 
</SCRIPT> 

% } else { 

<SCRIPT LANGUAGE=" JavaScript "> 
< i — 

//Reload this frame with mall URL 

parent . frames [Ij . location. href = " <%$mall_url%> " ; 
// — > 
</SCRIPT> 

% } 

<%ARGS> 

$ r e turnur 1 = >unde f 
$tag_start=> ' <FONT COLOR=red> ' 
$tag_end=> ' </FONT> ' 
</%ARGS> 



<%ARGS> 

$top=>undef 
$bottom=>undef 

$title=> ' Credit Card information' 

$amount=>undef 

$damt=>undef 

$store=>undef 

$ c on f i rm= >unde f 

$balance=>undef 

$process=>" INFO" 

</%ARGS> 

<%INIT> 

my $image_base = "https://fund.luciditygifts.com/images/giftcard"; 
my $new_balance = sprintf "%-2.2f", $ba 1 anc e+$ amount ; 

</%INIT> 

% if ($top) { 

<html> 

<body bgcolor =#FFFFFF background=<% $image_base %>/ribbonsbgc2 . gif topmargin=4> 
<center> 

<table width=700 bgcolor=f f f f f f border=0 cellpadding=2 cellspacing=0> 
<tr> 

<td valign=bottom> 

i=yimg src=<% $image_base %>/ addheadernew.gif >< ! <% $image„base %>/gold_logobt . gif > 
" : ™</td> 

^U<td align=center valign=bottomximg src=<% $image_base %>/bluevertl . gif width=7 
^Jieight=70> 
^</td> 

;F<td valign=bottom align=lef txf ont color^OOOOOO size=5 f ace=arial , helveticaxf on 
*Jt size=4 color=003399 f ace=arial , helvetica> 
HH%if ($process eq "CONFIRM") { 

!L: You will be <b>adding $<% $amount %></b> Bluemountain Gold Gift Certifica 

iH to yield a total balance of $<% $new__balance %>.</font> 

""%} else { 

\ % if ($store) { 

<brxb>You are $<% $amount %> short for your purchase at <% $store %>.</b 

|Hp<br> 

To add money to your Blue Gold, fill out the payment form below, 
m You will then be able to shop again. 

Ill You will then be returned to <% $store %> to complete your check-out! 

•S% } else { 

To add money to your Blue Gold, fill out the payment form below. 
O You will then be able to shop again. 

% } 
%} 

</td> 
</tr> 
<tr> 

<td colspan=3ximg src=<% $image__base %>/bluehorizh . gif border=Ox/td></ tr> 
</table> 

<table width=700 bgcolor =#FFFFFF border=0 cellspacing=0 cellpadding=0> 
<trxtd align=center> 



</font></f ont> 

</tdx/tr> 

</table> 

<table width=700 bgcolor=#66ccf f border=0 cellspacing=0 cellpadding=0> 

<trxtd colspan=4 width=100%>  </td> 

</tr> 

</table> 

< TABLE BORDER=0 BGCOLOR= " #6 6CCFF " CELLSPACING=0 CELLPADDING= 4 WIDTH=700><TR><TD> 

<FORM ACTION="add" METHOD=post> 
% } 

% if ($bottom) { 
</CENTER> 

< ! B IG>< / TD>< / TR> < / TABLE > 
&nbsp ; <br> 

</BODY> 
</HTML> 

%if (0) { 

s^fSfew end 

STABLE WIDTH="7 00" BGCOLOR="#99cccc n BORDER= ,I 0" CELLPADDING="0" CELLSPACING="0"> 

y <tr> 

Si <TD VALIGN= "bottom" ALIGN=" left 11 WIDTH= ,, 40" BGCOLOR= " #f f f f f f " > 

p <IMG SRC="<%$image„base%>/giftcard/gold_lbcorner,gif 11 BORDER= " 0 " WIDTH="40 

;r u HEIGHT= " 53 M ALT= " 11 HSPACE="0" VSPACE="0"> 

'H </TD> 

Iff <TD WIDTH=620> </TD> 

ill <TD WIDTH=40 VALIGN= "bottom" ALIGN = " right " BGCOLOR= '* #f f f f f f "> 

-•■~ 5 <IMG SRC="<%$image„base%>/gif tcard/gold_rbcorner .gif " border="0" WIDTH="40 

ifl" HEIGHT="53" ALT= " " HSPACE=" 0" VSPACE="0"> 
</TD> 

: </tr> 

I=^</TABLE> 
! ~</BODY> 

i y< / html> 



<%INIT> 

my (%missing) = (MissingCount=>0 ) ; 
my (%validation) = ( 

to_email 

card__exp__month 

card„exp_year 

amount 

amount 



> 'return ($ARGS{$key} = ~ / \w+\@ [ \w | \ .]+/)' , 

> 'return ($ARGS{$key} =~ /\d{2}/>', 

> 'return $ARGS{$key} =~ /\d{4}/', 

> 'return $ARGS{$key} =~ / A ( \d+\ . ?\d* | \ ,\d+) $/ ' 

> 'return $ARGS{$key} < 500', 



(%check_length) = 


( 




to_email 


=> 


100, 


card_f irst_name 


=> 


25, 


card_last„name 


=> 


25, 


company 


=> 


50, 


card_street 


=> 


60, 


card_apt 


-> 


5, 


card_city 


=> 


50, 


card_state 


=> 


50, 


card„z ipcode 


=> 


10, 


card_country 


=> 


50, 


area_code 


=> 


3, 


phone 


=> 


10, 


ext 


=> 


6, 



) ; 

'!5ny (©validation) = qw( 
z -lrJ amount 

''■-4 card_f irst_name card_last_name to_email card__type card_street 
^ card__city card_state card_zipcode card_country 
;P) ; 

l^oreach my $key ( ©validation) { 

unless {$ARGS{$key} ) { 

$missing{$key} = $star; 
ill $missing{MissingCount}++; 

} 

: .. } 

HjEoreach my $key (keys %validation) { 
;r; unless (eval $validation{ $key} ) { 
lU $missing{$key} = $star; 

IIJ $missing{MissingCount}++; 

^} } 

foreach my $key (keys %check_length) { 

if (length ( $ARGS { $key} ) > $check_length{ $key} ) { 

$missing{$key} = " $tag_start $key can only be $check_length{ $key} charac 
ters $tag_end" ; 

$missing{MissingCount } ++ ; 

} 

} 



if {$ARGS{card_number} ) { 

unless (mc_comp( ' / shared/credit /ccValidate ' , 

CCNumber=>$ARGS{card_number} , CCCardType=>$ARGS{card_type} ) ) { 
$missing{card_number} = " $tag_start This does not appear to be a correct 
Card Number. $tag_end" ; 




$missing{MissingCount } ++ ; 

} 

} else { 

$missing{card_number} = $star; 
$mi s sing {Miss ingCount}++ ; 



if { $ ARGS { amount } > $max_amount ) { 

$missing{ amount} = "$tag_start Maximum amount is \$$max_amount . $tag_end" ; 

$missing{MissingCount}++ ; 
} elsif ($ARGS{ amount} < $min_amount) { 

$missing{ amount} = "$tag_start Minimum amount is \$$min_amount . $tag__end" ; 

$missing{MissingCount}++; 



$missing{status} = $missing{MissingCount} ? 1 : 0; 
return %missing; 

</%INIT> 
<%ARGS> 

$tag_start=>'<FONT COLOR=red> ' 
$tag_end=>' </FONT> ' 
$ s t ar => " < FONT COLOR=r ed> * < / FONT> " 
$max_amoun t = > 5 0 0 
$min_amount=> ' . 01 ' 
i=l=/%ARGS> 





<html xheader > 

<META http-equiv=refresh content^" 90 ; url=<%$url%>"> 
</header> 

<body bgcolor=#f f f f f f topmargin=0> 
<center> 

<table width=680 bgcolor=FFFFFF> 
<tr> 

<td align=lef tximg src=/images/gif tcard/headerw. gif ></td> 

<td width=65% align=centerxf ont size=5> <b>Please wait</b> while the new funds 

are added to your Blue Mountain Gold Certificate. 

</font></bx/td> 

</tr> 

<tr> 

<td colspan=2 align=centerximg src=/ images /gif tcard/bluehorizh. gif ></td> 

</tr> 
<tr> 

<td colspan=2 align=center> < I bgcolor=99cccc> 
<font size=5 color=330099> 

<b>This process will take up to two minutes . </b><br> 

Once your Blue Gold balance has been successfully updated, you will be automatic 
ally 

returned where you left off .<brx/tdx/trxtr> 

<td colspan=2 align=centerximg src = /images/gif tcard/bluehorizh . gif x/tdx/trxt 
rxtd colspan=2> 
l^nbsp^pximg src = /images/gif tcard/hhogcp . gif ><br> 

^Lk / f ont> 
SJc/td> 
pk/table> 
■ He /bodyx /html > 

Hff:%once> 

,L.use URI:: Escape; 

lLk/%once> 

f Jk%init> 

" $returnurl = uri_escape ($returnurl , 11 A A-Za-zO-9" ) ; 

= my $url= "add_receipt?LOC=$LOC&u„id=$u_id&amount=$amount&balance=$balance&:order_ 
|^Ld=$order_idScreturnurl = $returnurl " ; 

!?!</%init> 
=Uc%args> 
=|$returnurl=>' ' 

^=$u_id=> ' ' 
i3?amount=>' ' 
~~$balance=> ' ' 

$order_id=> ' ' 

</%args> 



fflflf^ill^ 



mm 



mm * 
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<html><headerxtitle>Blue Gold Bar</titlex/header> 

<body background^ 1 bluevertl .gif " T0PMARGIN=4 LEFTMARGIN= 3 MARGINHEIGHT=3 MARGINW 
IDTH=3> 

<table cellspacing=0 cellpadding=0 height=60 width=99%> 

<trxtd width=145 valign=top rowspan=2> 
<img src=" lef tbluel3 , gif " border="0 M align= "lef t " 

hspace=0 vspace=0> 

</td> 

<td valign=middle align=center rowspan=2> 
<table> 

<trxtd><img src=balabs . gif > 

</td><td valign=top align=lef txf ont size=5 color=#003399 face=arial, 
helvetica> < ! color=003366> < ! color=#006699 size=5><!b>$40 . 49</bx/fontx/tdx/tr 
> 

</table> 

</td> 

<td valign=middle align=center><f ont color=003399 size=2 face=arial, helveticax 
bxi> 

To change stores, <br> click on "Shop Menu." 
</ix/bx/f ontx/td> 

<td align=right> 
Q <table cellspacing=0 cellpadding=0 border=0> 

Iri <tr> 

<td rowspan=2 valign=middlexa href =mallblue .html targe t=BOTTOM_F 
X&AMEximg src=shopblue.gif border=0>< I f latshop . gif border=0 alt=Shops>< Ibigyell> 
^/ax/td> 

l r Z <td rowspan=2 width=10>  </td> 

<td align=left valign=middle><a href =newaddblue . html target=BOTTO 
IfH_FRAMEximg src^addbuttt . gif border=0 alt=Addx/ax/tdxtd width=5> </tdx 

"ff <img src=coinsplash.gif width=38 height=32 hspace=0 vspace=0></t 

im> 

</trxtr> 

I . <td colspan=3 align=leftxa href =infohelp .html target=BOTTOM_FRAM 

■3=%ximg src=inf ohelpbutt.gif border=0 al t =Help>< / a>< / td>< / tr > 

i=1 </table> 



</td> 



</tr> 
</table> 



</bodyx/html> 



^pi^y^^:^\\\t ^:\- '- \ ' :: ' ...... 
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<HTML><HEAD> 

<TITLE>Blue Mountain Arts Charity Donation Page</TITLE> 
</HEAD> 

<BODY BGCOLOR= " #FFFFFF " background " sky_bg . gif " > 
<center> 

<table border="0" cellpadding=" 0 " cellspacing= " 0 " width="700"> 
<tr> 

<td><IMG SRC=" attcorner.gif" WIDTH= M 80" HEIGHT^ " 7 3 " >< / td> 
<td bgcolor="#cc99cc"><IMG SRC= "bmacharitytitlesm.gif " WIDTH="252" HEIGH 
T= "59"></td> 

<td bgcolor="#cc99cc" align= "lef t " valign= "middle "ximg src= "conf irmtitl 
e.gif" width="32 8" height =" 60 "></td> 

<tdxIMG SRC=" rtcorner.gif" WIDTH= ,! 40" HEIGHT="73 "x/td> 

</tr> 
</table> 

<table border=:"0" cellpadding=:" 0 " cellspacing= " 0 " width="700 "> 
<tr> 

<td width="15" bgcolor="#cc99cc'* height =" 50 11 >  </td> 
<td width="670" bgcolor="#cccccc"> </td> 
<td width="15" bgcolor="#cc99cc"> </td> 

</tr> 
</table> 

<table border=" 0" cellpadding=" 0 11 cellspacing= " 0 " width="700"> 
<tr> 

<td width="3 0"ximg src= n cc99cc_transpq3rl5 . gif " width="30" height="30"> 

!^/td> 

\^ <td width="640" bgcolor=' , #cc99cc"> </td> 

<td width="3 0"ximg src="cc9 9cc_transpq4rl5 . gif " width=" 30" height= "30 "> 

Vk/td> 
_p</tr> 

'^k/table> 

; =</center> 
"*k/BODY> 
j Fk / HTML> 
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<%PERL_INIT> 

my ©types = ( 

{ ' code ' => ' Amex' , ' name ' => 'American Express' }, 
{ ' code '=>' Visa ' , 'name ' => 'Visa ' }, 

) ; 

return { ©types ) ; 
</%PERL_INIT> 



<%doc> 

Passing a Credit Card number and a Credit Card type 
Check the validity of a card. 
Return 0 for bad card, 

1 for a good card. 
System cleans the number, does various logical checks 

and checks the cards actuall validity algorythm. 
I've only tested on one visa number. 
</%doc> 
<%init> 
my $result; 
my $offset; 

my $checkBit = substr ( $CCNumber , 0, 2); 

# remove noise 

$CCNumber =~ s/[\s\-]//g; 

return 0 if $CCNumber !~ / A \d+$/; 

my $CCLength = length $CCNumber; 

if (lc ($CCCardType) eq "visa") { 

return 0 unless $CCLength == 13 or $CCLength == 16; 

return 0 unless $checkBit =~ / A 4\d$/; 

$offset = 1; 
} elsif (lc ($CCCardType) eq "amex") { 

return 0 unless $CCLength == 15; 

return 0 unless $checkBit -= 34 or $checkBit == 37; 

$offset = 0; 
'^j elsif (lc ($CCCardType) eq "mastercard") { 
' L -A return 0 unless $CCLength == 16; 
_p return 0 unless $checkBit =~ / A 5\d$/; 
[\ $offset = 1; 

elsif (lc ($CCCardType) eq "discovery") { 
Ifl return 0 unless $CCLength == 16; 
74 return 0 unless $checkBit == 60; 
|f $offset = 1; 
I Ft} else { 

return 0; 

; .} 

rtoreach my $i (0 . . ( $CCLength-l ) ) { 

ffj my $bit = substr ( $CCNumber, $i, 1) ; 

5r 3 # determine if we should double the bit 

my $double = ($i+$offset) % 2; 
ill my $bitSum = $bit + ($double * $bit) ; 

$bitSum = substr ($bitSum / 0, 1) + substr ( $bitSum, 1 , 1 ) if $bitSum >= 10 
*;f $result += $bitSum; 

return i($result % 10); 

</%init> 

<%args> 

$CCNumber 

$CCCardType 

</%args> 



<%doc> 

Executes direct submission of a payment to CyberCash CashRegister 

Args : 
% sender 

- what are the keys 
%cc 

- what are the keys 
%order 

- what are the keys 

Returns : 
\%POP 

- what are the keys of this hash? 
\%tokenList 

- what are the keys of this hash? 
Example : 

mc_comp (' /shared/cr edit /charge ' , sender=>\%sender , cc=>\%sender , order=>\%order ) 

</%doc> 

<%args> 

% sender 
_%cc 
ijsorder 
*Jk/%args> 
;^:%init> 

'4ise CyberC: :CCMckLib3_2; 

.pise CyberC: :CCMckDirectLib3_2; 

I ; "use CyberC : : CCMckErrno3_2 ; 

ffhiy (%POP, %tokenList ); 

Initialize the Global Configuration array in CCMckLib3_2 
lf§ JW - change setting of $ConfigFile variable based on where it will eventually 
_ reside 

J my $Conf igFile= ' /home/www/servers/lucidity/app/lucidityinc-83/mck-cgi/conf /merch 
i^nt^conf ' ; 

llfny $status = CyberC :: CCMckLib3_2 :: InitConfig ( $ConfigFile) ; 
jJ4f ($status != 0) { 

flj $POP{status} = MCKGetErrorMessage ($status) ; 
=™ return (\%POP, \%tokenList) ; 

!? 

CyberC: :CCMckLib3„2 : : CCDebug {" Entering $0\n ,t ) ; 

my $cybercashld = $CyberC : : CCMckLib3_2 : :Conf ig{ "CYBERCASH_ID M } ; 
my $hashSecret = $CyberC : : CCMckLib3_2 : : Conf ig{ "HASH_SECRET" } ; 
my $ccpsHost = $CyberC : : CCMckLib3_2 : : Conf ig{ "CCPSJOST" } ; 
my $templateDir = $ CyberC : : CCMckLib3„2 : : Conf ig{ "TEMPLATE_DIR" } ; 
my $redirectURL = $CyberC : : CCMckLib3_2 : : Conf ig{ "REDIRECT_URL" } ; 

# A Note about message fields in paymentNVList . 

# paymentNVList holds message parameters 

# that will be passed to the Cash Register 
# 

# These parameters are broken into three blocks according to 

# a prefix in the argument field name. 



of this hash? 
of this hash? 
of this hash? 



lliiifllll 



Listing for 



Bautts 




# 

# prefix use 
# 

# mo. — data driving the Cash Register 

# this include Payment data and some operational options 

# cpi . — info about the Customer's "Payment Instrument: {credit/check 

# mf. — anything additional you want to pass on 

# to the Fulfillment Center 



my %paymentNVList; 

$paymentNVList{ 'mo. cybercash-id' } = $cybercashld; 

$paymentNVList{ 'mo. version ' } = $CyberC : :CCMckLib3_2 : :MCKversion; #CCPS message 
version 

# The MO and CPI blocks are not signed, since 

# the message will be encrypted 

$paymentNVList { 'mo . signed-cpi ' } = "no"; 

# Load payment instrument info from form 

if( I $order{order_id} ){ 

$paymentNVList{ 'mo . order- id' } = mc_comp ( ' /shared/utils/unique__id' } ; 
} else { 

=2 $paymentNVList { 'mo . order-id' } = $order {order_id} ; 

' J$paymentNVList{ 'mo .price ' } 
_^paymentNVList { ' cpi . card-number ' } 
[ r ~£paymentNVList { ' cpi . card-exp ' } 
^3>_year' }; 

H~£paymentNVList { ' cpi . card-name ' } 
r^t__name ' } ; 

;^$paymentNVList { ' cpi . card-address ' } 
! 1 ^$paymentNVList { ' cpi . card- city' } 
. $paymentNVList{ 'cpi .card-state' } 
\ ; $paymentNVList{ ' cpi .card- zip' } 
=^$paymentNVList { ' cpi . card- country ' } 

This is a CREDIT CARD payment 

DON'T TOUCH THIS J This is the CR script that will process your payment 
|ymy $script = "directcardpayment . cgi " ; 



= ' USD $order{ ' amount '} ; 
= $cc { ' card_number ' } ; 

= $cc { ' card_exp_month '}.'/'. $cc { ' card_ex 

= $sender { ' f irst_name ' } . ' ' . $sender { ' las 

= $sender {' street '}. ' ' . $sender {apt} ; 
= Ssender { ' city ' } ; 
= $sender {' state '} ; 
= $sender { ' zip ' } ; 
= $ sender { 'country' } ; 



########################### 

# No signatures required to talk to the Cash Register 

# NO SSL required to talk to the Cash Register either. . . 

# Since the whole thing is encrypted, crooks can't mess with it 

# and can't read it either! 
########################### 



# merchant-id gets added to the URL by the connection routine. 

# Don't add it here. . . 



my $paymentURL = " $ccpsHost$script " ; 

# At this point, all of the data that needs to go into the Payment message 

# should have been collected: So, we can call the Cash Register 

my ($POPref, $tokenListref ) = CyberC : : CCMckDirectLib3_2 : : doDirect Payment ( $payme 
ntURL, \%paymentNVList) ; 



%POP = %$POPref; 

%tokenList = %$tokenListref ; 

my $POPstr = $tokenList { ' POP ' } ; 

if ($POP{ 'pop. status ' } =~ /^success-duplicate/ ) { 

#add a message to the template 

$tokenList{'DUPLICATE_MSG' } 

= "<p>Please note that this order is a duplicate of one complete 
d previously</p>\n" ; 
} 

else { 

$tokenList{ ' DUPLICATE_MSG ' } = " "; # put in a blank to ensure substituti 

on 

} 

CyberC: : CCMckLib3_2 : : CCDebug (" Exiting $0\n") ; 

return (\%POP / \%tokenList) ; 

</%init> 



<%PERL_DOC> 

Component to encapsulate a call to app server to charge credit card. 
Should return: 

whether charge was accepted/declined 

information about the order 

any error information generated 

Which of the arguments are necessary? 



</%PERL_DOC> 
<%PERL_ARGS> 
$queue=>0 
$order_id=>' ' 
$amount=>'2001. 



00' 



$rcv_email=> ' jwintert@optonline . net ' 
$rcv_f irst_name=> 'Jennifer ' 
$rcv__last_name=> ' Winterton ' 
$snd_f irst_name=> ' Jason' 
$snd_last_name=> ' Taylor ' 
$snd_email=>' j smith© j smith. com' 
$card_type=> ' visa ' 
$card_number=>' 4111111111111111' 
$card_exp„month=> ' 12 ' 
$card_exp_year=> ' 04 ' 
$street=> ' 126-128 Church Street' 
i=^apt=>' ' 

'^city=>'San Francisco' 
^L£state=>'CA' 
Hj£zip_code=> ' 94114-1111 ' 
p$ c oun t ry = > ' US A ' 
: ^area_code=>' ' 
"Sj$phone=> ' ' 
= jrK/%PERL_ARGS> 
:lj<%PERL_INIT> 

Logically split data 



"my $receiver_data = { 
I ' emai 1 ' 

1--^ ' f irst_name ' 

= * = 'last_name' 



-> $rcv_email , 

=> $rcv_f irst_name , 

=> $rcv_last_name, 



Ijny $sender_data = { 
Z. ' f irst__name ' 

=f ' last_name' 

□ ' emai 1 ' 



= > $snd_f irst__name, 
=> $snd_last_name, 
=> $snd_email, 



my $cc__data = { 



' card_type' 


= > 


$card_type, 


' card_number ' 


= > 


$card_number, 


' card_exp_month 


= > 


$ c a r d__e xp_mo nth , 


' card__exp^year ' 


-> 


$card_exp_year , 


' street ' 


-> 


$street , 


'apt' 


=> 


$apt, 


' city' 


=> 


$city, 


' state ' 


=> 


$state, 


' zip_code ' 


=> 


$zip_code, 


' country' 


=> 


$country , 


' area„code ' 


=> 


$area_code, 



HI.,.. 

will! 




}; 



' phone ' 



my $order„data = { 
'order_id' 
' amount ' 

}; 



=> $phone, 



=> $order_id, 
=> $ amount, 



# Check for mandatory fields 

# Insert error checking code here 

# Check for correct formatting of data 

if( $cc_data->{ ' card_exp_year ' } =~ /"\d{3,4}$/ ) { 
$cc_data->{'card_exp„year' } =~ s/ ( . * ) < \d\d) $/$2/ ; 



Write information to database # 



# mc_comp( ' /api/record_data/writeSenderData' , data=>$sender_data ); 

# mc_comp( ' /api/record_data/writeRecieverData ' , data=>$receiver„data }; 

# mc_comp( ' /api/record_data/writeCCData' , data=>$cc_data ); 



Call to CyberCash module to charge 



-# 



finy ( $POPref , $tokenListref } =mc_comp{ ' /lucidity /app/ secure /credit_auth ' , send 
[ ^ r _da ta=>$sende r_da t a , 

'H cc_data=>$cc__data, order_data=>$order_data ) ; 

Jyny %POP = %$POPref; 

"Ay %tokenList = %$tokenListref ; 

# Place returned information in data structure # 

] my %result = { 

!=* 'status' => $POP{ 'pop . status '} , 

||J 'error' -> { 

'error_code' => '', 
= 7 error_message ' -> '', 

£~ = 'order' => { 

■^f ' order_no ' => ' 

O 'order amount' => '' 



}; 



Based on return codes, take some actions # 



if ( $result{ ' status' } =~ /f ai lure-hard | f ailure-q-or-cancel | f ailure-q-or-discard | 
failure-swversion/ ) { 

# queue the transaction 

$result{ ' status' } = 'queued'; 

} 

§ Record the transaction data # 

# Get the transaction data out of the return values here 



wimm>*- 




# mc_comp( ' /api/record_data/writeTransactionData' , data=>% transact ion_data ); 



#return( \%result ); 
return (\%POP); 

</%PERL_INIT> 



IliiiliiiiM 
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<%perl_doc> 

this component is used for a direct submission of a payment to CyberCash CashReg 
ister 

</%perl_doc> 

<%args> 

$order_id=> ' ' 

$amount=>0 

$f irst__name 

$last_name 

$card_number 

$card_exp_month 

$card_exp_year 

$street=>' ' 

$apt=>' ' 

$city=>' ' 

$state=> ' ' 

$zip_code 

$country=> ' ' 

</%args> 

<%once> 

use CyberC: :CCMckLib3__2; 

use CyberC : : CCMckDirectLib3_2 ; 

use CyberC :: CCMckErrno3_2 ; 

my (%sender / %cc, %order, %POP, %tokenList ); 

Initialize the Global Configuration array in CCMckLib3_2 
'3 JW - change setting of $ConfigFile variable based on where it will eventually 
* preside and confirm giftcat names 
Hiny $ConfigFile; 

glf ( $ARGS{ giftcat} eg ' charities ') { 

J% $ConfigFile = ' /home/www/servers/lucidity/app/lucidityinc-33 /mck-cgi/con 

'^If/merchant_conf ' ; 

:Lfelsif ($ARGS{ giftcat} eq 'giftcert'H 

$ConfigFile = ' /home/www/servers/lucidity/app/lucidityinc-83 /mck-cgi/con 
I pE / shine„c on f ' ; 
} 

; my $status = CyberC: :CCMckLib3_2 :: InitConfig ( $ConfigFile) ; 

;|j</%once> 
5 5 "j<%init> 

i Mlf ($status 1 = 0) { 

iU $POP{status} = MCKGetErrorMessage($status) ; 
return (\%POP, \%tokenList) ; 

CyberC: :CCMckLib3_2 : : CCDebug {" Entering $0\n" ) ; 

my $cybercashld = $CyberC : : CCMckLib3_2 : :Conf ig{ " CYBERC ASH_ID" } ; 
my $hashSecret = $CyberC : :CCMckLib3_2 : :Conf ig{ "HASH_SECRET" } ; 
my $ccpsHost = $CyberC: :CCMckLib3_2 : :Config{ "CCPS_HOST"}; 
my $templateDir = $CyberC : : CCMckLib3__2 : : Conf ig{ "TEMPLATEJDIR" } ; 
my $redirectURL = $CyberC : : CCMckLib3_2 : : Conf ig{ "REDIRECTMJRL" } ; 

# A Note about message fields in paymentNVList . 

# paymentNVList holds message parameters 

# that will be passed to the Cash Register 
# 

# These parameters are broken into three blocks according to 

# a prefix in the argument field name. 



# 

# prefix use 
# 

# mo. — data driving the Cash Register 

# this include Payment data and some operational options 

# cpi. — info about the Customer's "Payment Instrument: {credit /check 

) 

# mf . — anything additional you want to pass on 

# to the Fulfillment Center 

my %paymentNVList; 

$paymentNVList { 'mo . cybercash-id' } = $cybercashld; 

$paymentNVList{ 'mo. version' } = $CyberC : : CCMckLib3_2 : :MCKversion; #CCPS message 
version 

# The MO and CPI blocks are not signed, since 

# the message will be encrypted 

$paymentNVList { 'mo. signed-cpi ' } = "no"; 



# load payment instrument info from form 

if( ! defined ($order_id) || ! $order_id ){ 

$paymentNVList{ 'mo . order-id' } = mc_comp ( ' /shared/utils/unique_id ' ) ; 
rj} else { 

$paymentNVX)ist { 'mo . order-id' } = $order__id; 

s=$paymentNVList { 'mo. price' } 
"^~$paymentNVList { ' cpi . card-number ' } 
%J§paymentNVList { ' cpi . card-exp ' } 
| f^paymentNVList { ' cpi . card-name ' } 
jL^paymentNVList { ' cpi . card- address ' } 
^^paymentNVList { ' cpi . card-city' } 
^J^paymentNVList{ ' cpi . card-state ' } 
" $paymentNVList{ ' cpi . card-zip' } 
I $paymentNVList { ' cpi . card-country ' } 

lip This is a CREDIT CARD payment 

:'7$ DON'T TOUCH THIS I This is the CR script that will process your payment 
!Uny $script = "directcardpayment . cgi " ; 

Isdpriy $paymentURL = " $ccpsHost$script " ; 

lip At this point, all of the data that needs to go into the Payment message 

# should have been collected: So, we can call the Cash Register 

my ($POPref, $tokenListref } = CyberC :: CCMckDirectLib3_2 :: doDirect Payment ( $payme 
ntURL, \%paymentNVList) ; 

CyberC: : CCMckLib3_2 : :CCDebug ( "Exiting $0\n") ; 

return ($POPref ) ; 
</%init> 



- ' USD ' . $amount; 
= $card_number ; 

= $card„exp__month . ' / ' . $card_exp_year ; 

= $f irst_name . ' ' . $last_name ; 

= $apt ? $street.' '.$apt : $street; 

= $city; 

= $state; 

= $zip_code; 

= $ country; 




<%init> 

my $cookie; 

if ($ARGS{name} & $ARGS{value} ) { 

# Set cookie 

$cookie = new CGI:: Cookie 
( 

-name => $ ARGS { name } , 
-value => $ARGS{value} , 
-expires => $ARGS {expires } , 
-domain -> $ARGS {domain} , 
-path => $ARGS{path}, 
) ; 

$r->header„out (' Set-Cookie 7 ~> $cookie) ; 

} 

else { 

# Get cookie 

return fetch CGI: : Cookie { $r->header__in ( 'Cookie' ) ) ; 

} 

</%init> 



/pi 



<%perl_doc> 

this component is used for a direct submission of a payment to CyberCash CashReg 
ister 

<%/perl_doc> 
<%args> 
<%PERL_ARGS> 
$sender_data=> ' ' 
$cc_data=> ' ' 
$order_data=> ' ' 
</%PERL_ARGS> 
<%init> 

use CyberC :: CCMckLib3_2 qw ( $MCKversion %Config URLdecodeForm 
InitConfig CCError CCDebug CCDebug2 GetQuery 
PrintTemplate LoadBlockFromQuery 
BuildSignature ) ; 

use CyberC: :CCMckDirectLib3_2 qw (doDirect Payment ) ; 

use CyberC: :CCMckErrno3_2 qw (MCKGetErrorMessage $E„NoErr 
$E_Fail_Notif 
$E_Payment_Failed 
$ E__No_Re c e i p t 

$ E_MO_S i gna tu r e 

$E_MF_Signature 

$ E_No_Temp late 

■Hny (%POP, %tokenList) ; 

B r# Initialize the Global Configuration array in CCMckLib3_2 

[ r f JW - change setting of $ConfigFile variable based on where it will eventually 
Reside 

! infoy $Conf igFile= ' /www/ servers /lucidity/app/test-mck/mck-cgi/conf /merchant_conf ' 
i^ny $status = ScInitConf ig ($Conf igFile) ; 

^pLf ($status != 0) { 

$POP{status} = &MCKGetErrorMessage{$status) ; 
! return (\%POP, \%tokenList) ; 

I : fkCCDebug{ "Entering $0\n" ) ; 

jjljny $cybercashld = $Conf ig{ "CYBERCASH„ID" } ; 
s=*ny $hashSecret = $Conf ig{ " HASH_SECRET " } ; 
:3^y $ccpsHost = $Config{ "CCPS_H0ST" } ; 
^□ny $templateDir = $Conf ig{ "TEMPLATE_DIR" } ; 
my $redirectURL = $Conf ig{ "REDIRECTMJRL" } ; 

# A Note about message fields in paymentNVList . 

# paymentNVList holds message parameters 

# that will be passed to the Cash Register 
# 

# These parameters are broken into three blocks according to 

# a prefix in the argument field name. 
# 

# prefix use 
# 

# mo. — data driving the Cash Register 

# this include Payment data and some operational options 

# cpi . — info about the Customer's "Payment Instrument: ( credit /check 



ill 



....... 




) 

# mf . — anything additional you want to pass on 

# to the Fulfillment Center 

my %paymentNVList ; 

$paymentNVList { 'mo . cybercash-id' } = $cybercashld; 

$paymentNVList{ 'mo. version' } = $MCKversion; #CCPS message version 

# The MO and CPI blocks are not signed, since 

# the message will be encrypted 

$paymentNVList{ 'mo . signed-cpi ' } = "no" ; 



# load payment instrument info from form 

if( ! defined ($order„data->{ order_id} ) || ! $order_data->{order_id} ){ 

$paymentNVList { 'mo . order-id' } = mc_comp( ' / shared/ credit_card/uniqueld' ) ; 
} else { 

$paymentNVList{ 'mo . order-id' } = $order_data->{order_id} ; 

} 

$paymentNVList{ 'mo .price ' } = ' USD '. $order_data->{ ' amount '} ; 

$paymentNVList { ' cpi . card-number ' } = $cc__data-> { ' card_number ' } ; 

$paymentNVList { ' cpi . card-exp ' } = $cc_data-> { ' card_exp_month' }.'/'. $cc__d 

f33,ta->{ ' card__exp__year ' } ; 

^paymentNVList{ ' cpi . card-name' } = $sender_data-> { ' f irst_name' } . ' ' . $send 

"Mbr„data-> { ' last_name ' } ; 

' ; -J?paymentNVList{ ' cpi . card-address ' } = $sender_data { ' street 7 } . ' ' . $sender_dat 

_ga{apt} ; 

[ : £paymentNVList {' cpi . card-city ' } = $sender_data{ ' city ' } ; 

'-^paymentNVList{ ' cpi . card-state' } = $sender_data{ ' state '} ; 

ff$paymentNVList {' cpi . card- zip' } = $sender_data{ ' zip' } ; 

iL^paymentNVList {' cpi . card-country ' } - $sender_data{ ' country '} ; 

iff This is a CREDIT CARD payment 

/# DON'T TOUCH THIS! This is the CR script that will process your payment 
'my $script = "directcardpayment . cgi" ; 

|y n ######################### 

# No signatures required to talk to the Cash Register 
^ # NO SSL required to talk to the Cash Register either. . . 

flj # Since the whole thing is encrypted, crooks can't mess with it 

= == # and can't read it either! 

■f M ######################### 

# merchant-id gets added to the URL by the connection routine. 

# Don't add it here. . . 

my $paymentURL = " $ccpsHost$script " ; 

#At this point, all of the data that needs to go into the Payment message 

# should have been collected: So, we can call the Cash Register 

my ($POPref, $tokenListref ) = &doDirectPayment ( $paymentURL, \%paymentNVList) ; 

%POP = %$POPref; 

%tokenList = %$tokenListref ; 

my $POPstr = $tokenLis t { ' POP ' } ; 



if ($POP{ 'pop. status ' } =- /^success-duplicate/ ) { 

#add a message to the template 

$tokenList{ ' DUPLICATE_MSG' } 

= "<p>Please note that this order is a duplicate of one complete 
d previously</p>\n" ; 
} 

else { • 

$tokenList{ 'DUPLICATE_MSG' } = " " ; # put in a blank to ensure substituti 

on 
} 

&CCDebug( "Exiting $0\n"); 
return {\%POP, \%tokenList) ; 



<%perl_doc> 

this component is used for a direct submission of a payment to CyberCash CashReg 
ister 

</%perl_doc> 
<%args> 

$sender__data=> ' ' 
$cc_data=> ' ' 
$order_data=> ' ' 
</%args> 
<%init> 

use CyberC : : CCMckLib3_2 ; 

use CyberC: :CCMckDirectLib3_2; 

use CyberC : : CCMckErrno3_2 ; 

my (%sender, %cc, %order, %POP, %tokenList ); 
% sender = %$ sender _dat a; 
%cc = %$cc_data; 
%order = %$order_data; 

# Initialize the Global Configuration array in CCMckLib3_2 

# JW - change setting of $ConfigFile variable based on where it will eventually 
reside 

my $Conf igFile=' /home/www/servers/lucidity/app/lucidityinc-83/mck-cgi/conf /merch 
ant_conf ' ; 

my $status = CyberC: :CCMckLib3_2 :: InitConfig{ $ConfigFile) ; 
($status ! = 0) { 

$POP{status} = MCKGetErrorMessage($status) ; 
"'H return (\%POP, \%tokenList) ; 

'CyberC: : CCMckLib3_2 : : CCDebug (" Entering $0\n") ; 

lliay $cybercashld = $CyberC : :CCMckLib3_2 : :Conf ig{ " CYBERC ASH_ID" } ; 
^4ny $hashSecret = $CyberC : :CCMckLib3_2 : : Conf ig{ " HASH_SECRET " } ; 
ytny $ccpsHost = $CyberC: :CCMckLib3_2 : : Conf ig{ "CCPS.HOST" }; 
s my $templateDir = $ CyberC : :CCMckLib3_2 : :Conf ig{ "TEMPLATE__DIR" } ; 
Ijay $redirectURL = $CyberC : :CCMckLib3_2 : :Conf ig{ "REDIRECT_URL" } ; 

flj # A Note about message fields in paymentNVList . 

l{l # paymentNVList holds message parameters 

=^ # that will be passed to the Cash Register 

\U # 

==^ # These parameters are broken into three blocks according to 

# a prefix in the argument field name. 
U # 

# prefix use 
# 

# mo. — data driving the Cash Register 

# this include Payment data and some operational options 

# cpi. — info about the Customer's "Payment Instrument: {credit /check 

) 

# mf . — anything additional you want to pass on 

# to the Fulfillment Center 



my %paymentNVList ; 

$paymentNVList{ 'mo. cyber cash-id ' } = $cybercashld; 

$paymentNVList { 'mo .version' } = $CyberC : :CCMckLib3_2 : :MCKversion; #CCPS message 
version 



# The MO and CPI blocks are not signed, since 

# the message will be encrypted 

$paymentNVList { 'mo . signed-cpi ' } = "no"; 



# load payment instrument info from form 



if( ! defined ($order {order_id} ) || ! $order {order„id} ){ 

$paymentNVList { 'mo . order -id' } = mc_comp ( ' /shared /utils /unique Id' ) ; 
} else { 

$paymentNVList { 'mo . order-id' } = $order {order„id} ; 

} 



$paymentNVList { 'mo .price ' } 
$paymentNVList { ' cpi . card-number' } 
$paymentNVList { ' cpi . card-exp ' } 
p_year ' } ; 

$paymentNVList { ' cpi . card-name ' } 
t__name ' } ; 

$paymentNVList { ' cpi . card-address ' } 
$paymentNVList{ ' cpi . card-city ' } 
$paymentNVList { ' cpi . card-state ' } 
$paymentNVList{ ' cpi . card- zip' } 
$paymentNVList{ ' cpi . card-country' } 

,]3 This is a CREDIT CARD payment 

DON'T TOUCH THIS! This is the CR script that will process your payment 
'Nfty $script = " directcardpayment . cgi " ; 

#fl ######################### 

# No signatures required to talk to the Cash Register 
|H # NO SSL required to talk to the Cash Register either. . . 

i'v* # Since the whole thing is encrypted, crooks can't mess with it 

: - r f # and can't read it either! 

\h M ######################### 

] .# merchant-id gets added to the URL by the connection routine. 
I^t Don't add it here. . . 

sTmy $paymentURL = " $ccpsHost$script " ; 

llftAt this point, all of the data that needs to go into the Payment message 
= should have been collected: So, we can call the Cash Register 

"fjay ($POPref, $tokenListref } = CyberC : : CCMckDirectLib3_2 : : doDirectPayment ( $payme 
^tURL, \%paymentNVList) ; 

%POP = %$POPref; 

%tokenList = %$tokenListref ; 

my $POPstr = $tokenList { ' POP ' } ; 



= 'USD $order{ ' amount '} ; 
= $cc{ ' card_number ' } ; 

= $cc { ' card_exp_month '}.'/'. $cc{' card_ex 

= $sender{ ' f irst„name ' } . ' ' . $sender { ' las 

= $sender {' street '}. ' ' . $sender {apt } ; 
= $sender { ' city ' } ; 

- $sender {' state '} ; 
= $ sender { ' zip' } ; 

- $ sender {' country '} ; 



if { $POP{ 'pop . status ' } =~ /^success-duplicate/ ) { 

#add a message to the template 

$tokenList{ ' DUPLICATE_MSG ' } 

= " <p>Please note that this order is a duplicate of one complete 
d previously</p>\n" ; 
} 

else { 

$tokenList{ 'DUPLICATE_MSG' } = " "; # put in a blank to ensure substituti 

on 
} 
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CyberC: :CCMckLib3_2 : : CCDebug ( "Exiting $0\n" ) ; 

return (\%POP / \%tokenList) ; 

</%init> 
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Tue May 918:17:412000 




<%PERL„ARGS> 
$selected=> ' ' 
$name=> ' ' 

</%FERL_ARGS> 
<%PERL_INIT> 

my @card_types = mc_comp{ ' /shared/ credit /card_types ' ); 

</%PERL_INIT> 

<SELECT NAME="<%$name%>"> 

<OPTION VALUE="-l ,l >Select card type 
% foreach my $type { @card_types ) { 
% if{ $selected eq $type->{ ' code ' } ) { 

<OPTION VALUE="<%$type->{ 'code' }%>" SELECTED><%$ type-> { ' name ' }%> 
% } else { 

<OPTION VALUED "<%$type->{ 'code' }%>"><% $type->{ 'name ' }%> 

% } 
% } 

</SELECT> 
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: TueWay 9 18:17:41 2000 , ■ 




We are sorry, there appears to have been an error with your order. <BR> 

Please bookmark <A HREF-"<% $resolve_url %>">this link</A> and check back later. 

<BR> 

Thanks , <BR> 

The Management<BR> 

<%init> 

my $resolve_url = "https : //secure . luciditygifts . com/ charity/resolve?$error_id" ; 

mc_comp { ' /shared/utils/log_error ' , url=>$url, return=>$return, gif tcat=>$ARGS {gi 

ftcat}, %ARGS) ; 

</%init> 

<%args> 

$url=>undef 

$return=>undef 

$ err or_id= >unde f 

</%args> 
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%if ($top) { 

<HTML> 

<HEAD> 

<TITLE>Add Funds to Your Bluemountain Gold</TITLE> 
</HEAD> 



<BODY BGCOLOR= " #FFFFFF " TEXT= "#000000" LINK= "#990000" VLINK= " #FF9900 " > 



<CENTER> 



< TABLE BORDER=0 BGCOLOR= " #f f f f f f " CELLSPACINGS CELLPADDING=4 WIDTH=7 0 0 >< ! FFFFCC 
> 

<TR> 

<TD><IMG SRC="/images/giftcard/gold_logob.gif " ALT= ,II, WIDTH=164 HEIGHT=109 H 
SPACE^O VSPACE=0x/TD> 

<TD VALIGN=middle ALIGN=left> 

<FONT FACE= "Helvetica , Arial"Q SIZE=2 COLOR= " #003399 " > 

Unfortunately, something bad seems to have happened. Please try again in a 
few minutes . We 

have been notified and will look into it immediately. 

<br> 

</FONT> 

<FONT FACE=" Helvetica, Arial"Q SIZE=2 COLOR=" #003399 "> <center> 
^i>Bluemountain respects your privacy, and provides you with secure transactions 

ifl </i> 
u -</center> 

" v ~h / TD> 

g </TR> 

_</TABLE><center> 

] fjk ! BIGxTABLE BORDER=0 BGCOLOR= " #99cccc " CELLSPACING=0 CELLPADDING=4 WIDTH=700><T 

:^><TD> 

\ FkFORM ACTI ON= " charge " METHOD=post> 
= %} 

l^if ($bottom) { 

I Ik ! BIGx /TD>< / TRx / TABLE> 

=r</BODY> 

E " y </HTML> 

Ilk) 

;=7<%args> 
!Ii$top=>undef 
\ rJ$bo 1 1 om= >unde f 
</%args> 
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BEGIN CERTIFICATE 

MIIC8zCCAlygAwIBAgIDAKtCMA0GCSqGSIb3DQEBBAUAMIHEMQswCQYDVQQGEwJa 
QTETVMBMGAlUECBMMV2VzdGVybiBDYXBlMRIwEAYDVQQHEwlDYXBlIFRvd24xHTAb 
BgNVBAoTFFRoYXd0ZSBDb2 5zdWx0aW5nIGNjMSgwJgYDVQQLEx9DZXJ0aWZpY2F0 
aW9uIFNlcn ZpY2 Vz I ERpdml zaW9uMRkwFwYDVQQDExBUaGF3 dGUgU2 VydmVylENB 
MSYwJAYJKoZIhvcNAQkBFhdz ZXJ2 ZXI tY2 VydHNAdGhhd3Rl LmNvbTAeFwO 50TEy 
MTIwN j MlNDBaFwOwMDEyM j UwN j MlNDBaMIGQMQswCQYDVQQGEwJVUzETMBEGAlUE 
CBMKQ2FsaWZvcm5pYTEWMBQGAlUEBxMIW2Fu^ 

THVj aWRpdHksIEluYy4xG j AYBgNVBAsTEWxlY2 lkaXRS Z 2 lmdHMuY2 9 tMR8wHQYD 
VQQDExZmdW5kLrnxlY21kaXR5Z21mdHMuY29tMIGfMA0GCSqGSIb3DQEBAQUAA4GN 
ADCBiQKBgQC+LdMchoCgl4RcFf j TDQJFGiOJPMPU2wlSB/OCGYcgdIco91t8DdPd 
Hxvivp56BJCkrn+gcPWLvSElNxw03n+/VsqMNKbmPPKd8xsIOCx+oHEHtHEzf SEQ 
aaibGjbCTaaNlGFHEQzQD+bbeo2vwVbnJe3WXBKWnIGKyVGF6iUCcwIDAQABoyUw 
I z ATBgNVHSUEDDAKBggrBgEFBQcDATAMBgNVHRMBAf 8 EA j AAMAOGC SqGS Ib3 DQEB 
B AUAA4 G B AC dhX etCDrZ6f bVFb Z J C hOMUDKwO 7 X P 1 1 h f hEM 8 V+ eh 6 U Yb 9 PbLGu Ya 0 
pBwOExyLnQphstvSAdDf 2f 5twhKFlwIH9ul52dpoZswh+lqbSdqM4REwwQqG97 16 
4Qho8BrMRr7rlKlX59WcuAPvGLG961QgH2Rhetk0qSpBOd0Zpsso 
END CERTIFICATE 



<%doc> 

Component to get the LOC based on the u__id 

</%doc> 
<%args> 
$u_id 
</%args> 
<%init> 

my{ %data, $value ) ; 
my $giftcard = "10.20.1.53"; 
my $url = "http: //$gif tcard/process/get_LOC?u__id=$u_id" ; 

my $call„ret = mc__comp {' /shared/ http /lwp__call ' , url=>$url ; data=>\%data ); 

if ( $call_ret == 200 ) { 

$value = $data { ' LOC ' } ; 
} else { 

$value = 0; 

} 

return $value; 
</%init> 
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<%doc> 

this component queries the database based on the passed arguments and determines 
if card has been created for user. If so, it returns the card number. If not, 
it returns a 0. 

</%doc> 

<%init> 

my $card_no=0; 

my $sql = 'select rcv_giftcard from orders where u_id=:l'; 
my $dbh = DBI->connect (' DBI : Oracle : ligifts ' ) 

or die "Couldn't connect to database: " . DBI->errstr; 
my $sth = $dbh->prepare { $sql) 

or die "Couldn't prepare statement: " . $dbh->errstr ; 

return $card__no; 
</%init> 
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# ! /usr/bin/perl 

use strict; 

use Apache: :DBI; 

use Apache: : Constants qw(:common); 

# Global DB connection 
my ($dbh) ; 

sub init_bandler 
{ 

$dbh = DBI->connect('DBI:mysql:database=trail;host=localhost' , '', '', {Rais 
eError => 1} ) ; 
} 

sub exit_handler 
{ 

$dbh-> disconnect; 

} 

sub level l_handler 
{ 

my $r = shift; 

|3 # Setup header and return blank gif 
$r->send_http_header ( ' image /gif ' ) ; 

open {IMG, ' /local/lucidity/ trail/htdocs/O/pixel . gif ' ) or die " $$: Cannot ope 
file: $! " ; 
p $r->send_fd{*IMG} ; 
[ r : close { IMG); 

jfj # Parse URI and setup notes for later logging 

•~~ my ($tmp, $action, $partner, $section, $uid, $amount) = split {/\// f $r->uri 

y ; 

In my $query_string = $r->args; # or %query_string = $r->args; 

l_ $r->notes { ' LUCD_ACTION ' => $action) ; 

$r->notes { ' LUCD_PARTNER ' => $partner) ; 
Ifj $r->notes ( ' LUCD_SECTION' => $section) ; 
55"= $r->notes{ 'LUCD_UID' => $uid) ; 
1 1* $r->notes ( 'LUCD_AMOUNT' => $amount) ; 

= # Insert into DB if action accept 

;:f if ($action eq 'accept') { 

flj my $sth = $dbh->prepare ( qq/ insert into user_clicks {action, partner, sec 

tion, uid, amount, query_string) values {'$action', '$partner', '$section', ' $ui 
d' , '$ amount ' $query__string ' ) / ) ; 

$sth->execute ; 

$sth->f inish; 

} 

return OK; 

} 



# 1 /usr/bin/perl 



package HTML: : Mason; 
# 

# Sample Mason handler. 
# 

use HTML: : Mason; 
use strict; 

# Uncortunent the next line if you plan to use the Mason previewer . 
#use HTML: : Mason: : Preview ; 

# List of modules that you want to use from components (see Admin 

# manual for details) 
{ 

package HTML: : Mason: : Commands; 

use CGI qw{ : standard) ; 

use CGI: : Cookie; 

use Date: :Manip; 

use LWP: : User Agent; 

use HTTP: : Cookies; 

use HTTP: : Request; 

use HTTP: : Response; 

use HTML: : Entities; 

0 use Apache :: Session: : File; 

~--S Create Mason objects 

,* : my $parser = new HTML :: Mason :: Parser ; 
Hay $interp = new HTML :: Mason :: Interp 

in < 

.;== parser=>$parser , 

^fj comp_root=> ' /home/ lucidity/ front/ fund/comps ' , 
!H data„dir=>' /home /lucidity/ front /fund/mason' 
) ? 

1 my $ah = new HTML: : Mason: : ApacheHandler (interp=>$ interp) ; 

$ah->output„mode ( "stream" ) ; 
HI $ah->error„mode ( " fatal " ) ; 

yf# Activate the following if running httpd as root (the normal case) . 
113 Resets ownership of all files created by Mason at startup. Change 
these to match your server's 'User' and 'Group' . 

■3 

sjchown (scalar (getpwnam "nobody"), scalar (getgrnam "tech")/ 
$interp->f iles_written) ; 

sub handler 
{ 

my $r = shift; 

# If you plan to intermix images in the same directory as 

# components, activate the following to prevent Mason from 

# evaluating image files as components. 
# 

return -1 if $r-> contents type && $r->content_type ! ~ m| A text/|io; 

# This block of code can be enabled to create a session-hash that every 

# component can access. This is useful for maintaining state across 



# multiple requests. The Apache :: Session module is required. 
# 

#my %session; 

#my $cookie = $r->header_in (' Cookie ') ; 
#$cookie =~ s/SESSION_ID=(\w*) /$!/; 

#tie %session, ' Apache: : Session: : File' , $cookie, {'Directory' => '/tmp/sessi 
on'}; 

#$r->header__out ( "Set-Cookie" => "SESSION_ID=$session{_session_id} ; " ) if ( !$ 
cookie ) ; 

# This creates a global called %session that is accessible in all components 

# Feel free to rename this as needed. 
# 

#local *HTML: : Mason: : Commands : : session = \%session; 

$ah->handle_request ( $r ) ; 

#untie %HTML: : Mason: : Commands: : session; 

} 

l; 
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you made it to fundO ! 
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ServerName fund. luciditygif ts . com 

ResourceConf ig /dev/null 
AccessConfig /dev/null 

DefaultType text/html 
#Options -Indexes 

User nobody 
Group tech 

ServerRoot /home /lucidity/ front /fund/ servers 
DocumentRoot /home/ lucidity/ f ront / f und/comps 

Redirect /index. html http://www.lucidityinc.com/00/mainpage.html 
Redirect /home http://www.lucidityinc.com/00/mainpage.htrnl 

Redirect / cgi -bin/ vendor /gc fund https : //fund. luciditygif ts . com/gif tcard/add 
ErrorLog logs/error 

LogFormat "%h %1 %u %t \"%r\" %s %b \ "% {Ref erer} i\ " \ "% {User-Agent } i\ " \"%{cooki 
e}n\" %T" 

TransferLog logs/access . httpd 

MaxClients 60 
StartServers 50 
;i^inSpareServers 40 

^axRequestsPerChild 100 



"%pi rectory Index home index.html 

I OPerlRequire /home/ lucidity / front / fund/ servers / conf /handler . pi 
JLJPerlTransHandler main: : trans_handler 

IfkLocation /> 

SetHandler perl-script 
I _ PerlHandler HTML: : Mason 
fss #PerlTypeHandler main ; : typejhandler 
||J #PerlFixupHandler main : : f ixup_handler 
;zl</Location> 

ffkLocation /cgi-bin> 
^ SetHandler cgi-script 



";ff</Location> 



<Location /ps> 

SetHandler perl-script 
PerlHandler Apache :: Status 

</Location> 






ServerName fund.luciditygifts.com 
ServerType standalone 

Port 443 

ResourceConf ig /dev/null 
AccessConfig /dev/null 

DefaultType text/html 
#Options -Indexes 

Redirect /cgi-bin/vendor/gcfund https://fund.luciditygifts.com/giftcard/add 

SSLEngine on 
SSLVerifyClient 0 
SSLVerifyDepth 10 

SSLCertificateFile /home/lucidrty/f ront/fund/servers/conf /keys/fund. crt 

User nobody 
Group tech 

ServerRoot /home/ lucidity/ front /fund/ servers 
DocumentRoo t /home / luc idi ty / front / f und/ comps 

ZSrrorLog logs /error 

M? g f? r ^n " %h %1 %U %t V ' %rV ' %s %b \'*%{Referer}i\" \ «% {User-Agent } i \ " \"%{cooki 
. e / n \ ^1 

'transfer Log logs /access 

[flflaxClients 60 
/jS tartS ervers 50 
IfltfinSpareServers 40 
l^axSpareServers 60 
;j^axRequestsPerChild 100 

; Directorylndex home index.html 

^erlRequire /home/lucidity/front/f und/servers/conf /handler pi 
ryttPerlTransHandler main : : trans_handler 

^Location /> 

y SetHandler perl-script 
2 PerlHandler HTML: ; Mason 
'Z #PerlTypeHandler main : : type_handler 
=5 #PerlFixupHandler main: : f ixup_handler 
</Location> 

<Location /cgi-bin> 
SetHandler cgi-script 
</Location> 

<Location /ps> 

SetHandler perl-script 

PerlHandler Apache : : Status 
</Location> 



<HTMLxHEAD> 

<TITLE>Blue Mountain Arts Charity Gift Center - 1</TITLE> 
</HEAD> 

<BODY BGCOLOR= " #FFFFFF " background="sky_bg . gif "> 
<center> 

<table border="0" cellpadding= " 0 " cellspacing^" 0 " width="700"> 
<tr> 

<td><IMG SRC=" attcorner.gif" WIDTH="80" HEIGHT= " 73 " ></ td> 
<td bgcolor="#cc99cc"><IMG SRC="bmacharitytitle. gif " WIDTH="310" HEIGHT= 
"73"></td> 

<td width="270" bgcolor^ "#cc99cc" align="left ,t valign= " top">  <p>bla 
h text</td> 

<td><IMG SRC=" rtcorner.gif" WIDTH="40 n HEIGHT="73 "></td> 

</tr> 
</table> 

<table border="0" cellpadding= " 0 " cellspacing= " 0 " width="700"> 
<tr> 

<td width="15" height="5" bgcolor="#cc99cc" >  </td> 
<td width="100" height="5" bgcolor= " #cc99cc" >  </td> 
<td width="14" height="5" bgcolor= " #cc99cc " >  </td> 
<td width="100" height= ,, 5" bgcolor=" #cc99cc">  </td> 
<td width="14" height="5" bgcolor= " #cc99cc " >  </ td> 
<td width="100" height="5" bgcolor="#cc99cc n > </td> 
<td widths "7" height="5" bgcolor= " #cc99cc " >&nbsp ; </td> 
<td width="7" height="5" bgcolor="#cc99cc"> </td> 
III <td width="100" height="5" bgcolor= " #cc99cc " >  </td> 

<td width="14" height ="5" bgcolor ="#cc99cc"> </td> 
V s *. <td width="100" height="5" bgcolor="#cc99cc">  </td> 

'H <td width="14" height="5" bgcolor =" #cc99cc ">  </td> 

,c <td width="100" height="5" bgcolor="#cc99cc">  </td> 

<td width="15" heights "5" bgcolor="#cc99cc"> </td> 

^/tr> 
I|Ktr> 

= <td bgcolor="#cc99cc n >5cnbsp;</td> 

:rf <td colspan="5" bgcolor="#cc99cc" align=" lef t " valign=" top"ximg src="ch 

y~bosetitle.gif" width="328" height= " 60 " ></td> 

<td colspan="2" bgcolor^ " #cc99cc 11 >  </td> 
] „ <td colspan=" 5" bgcolor=" #cc99cc" align= ,, left" valign= "bottom" >Click "de 

snails" to find out more about the charity. <P> 
fLciick "select" to go directly to the donation page.</td> 
§fi <td bgcolor=" #cc9 9cc" >  </td> 

^/tr> 
I|ktr> 

1=1 <td bgcolor=" #cc99cc " colspan="14" height= " 14 " >  </td> 

:!f</tr> 

Vj<tr> 

<td bgcolor= " #cc99cc " >&nbsp ; </ td> 

<td bgcolor=" #cc99cc" align= "center " valign= "middle" xIMG usemap= " #acs_m 
ap" SRC="charities/acs_det.gif " WIDTH="100 M height=" 120 " border="0"></td> 
<td bgcolor= " #cc99cc ">  </td> 

<td bgcolor="#cc99cc " align= "center 11 valign= "middle" xIMG usemap="#egpaf 
_map" SRC="charities/egpaf _det.gif " WIDTH="100" height="120" border= " 0 " ></td> 
<td bgcolor= " #cc99cc " >  </ td> 

<td bgcolor^" #cc99cc" align= "center" valign= "middle "xIMG usemap=" #hsus_ 
map" SRC=" charities /hsus_det .gif 11 width="100" height= " 120 " border= " 0 " ></td> 
<td colspan="2 " bgcolor= ,l #cc99cc"> </td> 

<td bgcolor= " #cc99cc " align=" center" valign= "middle" ><IMG usemap= " #mawf _ 
map" SRC= n charities/mawf _det.gif" width=" 100 " height="120" border= " 0 "></td> 
<td bgcolor=" #cc99cc ">£cnbsp; </td> 

<td bgcolor=" #cc99cc " align= " center " valign= "middle" >< IMG usemap= " #oxf am 




<td bgcolor- " #cc99cc " >&nbsp ; </td> 

</tr> 
<tr> 

<td colspan-"13" bgcolor-" #cc99cc " align= " right "><a href =« index2 htmi»^ 
ung src-morecharities.gif" width=U00» height- 30 « border*" 0 "></a></td> 
if" widtn^l^ valign-<Wdle"xi m g sr. Ttarro.. g 

</tr> 
</table> 

<table border="0" 
<tr> 



cellpadding="0" cellspacing=" 0 " width= "7 00 "> 



; */tr> 
~~-ktr> 



<td width="15" height="20" 
<td width="15 M height="20" 
<td width= ,, 15" height="20" 
<td width="260" height-"20 
<td width="15" height="20" 
<td width="15" height="20" 
<td widths "15" heights "2 0" 
<td width- "15" height ="20" 
<td width- "15" height- "2 0" 
<td widths "15" height- "20" 
<td width- "2 60" heights "20 
<td width="15" height="20" 
<td width= M 15" height-" 20" 
<td widths "15 ~ ' 



bgcolors " #cc9 9cc " >&nbsp ; < / td> 
bgcolor="#cc99cc"> </td> 
bgcolor= " #cc99cc ">  </td> 
" bgcolor = "#009900" >&nbsp ; < / td> 

bgcolor="#cc99cc"> </td> 
bgcolor= " #cc99cc " >  </ td> 

bgcolor- "#cc99cc"> </td> 
bgcolor="#cc99cc"> </td> 
bgcolor= " #cc99cc " >  </ td> 
bgcolor- "#009900" >&nbsp ; < / td> 
' bgcolor- " #cc99cc " >&nbsp ; </td> 
bgcolor= " #cc9 9cc " >&nbsp ; </ td> 
bgcolor = " #cc9 9cc " >&nbsp ; < / td> 
height= " 20 " bgcolor- " #cc99cc " >  </ td> 



In <td bgcolor-"#cc99cc">&:nbsp;</td> 

^<w^ 1o CO ?• S ?^ n=, .l ,, bgcolor="#99ccff" align="center " valign=" top" ><IMG SRC-" 
.^9ccf f_cc99ccqlrl5.gif" WIDTH--30" HEIGHT- " 3 0 " >< / td> 

-f- s <td bgcolor-" #99ccff" align= "center " valign- " top"xlMG SRC- "aboutchaH t i 

es.gif" WIDTH- "260" HEIGHT- " 3 0 " x/td> aDoutcnanti 

^ Q « < ^ CO J span= " 2 " bgcolor="#99ccff " align- "center « valign= top" ><IMG SRC- " 

jS9ccf f_cc99ccq2rl5.gif" WIDTH-"30" HEIGHT- " 30 "x/td> 

y <td colspan= ,, 2" bgcolor- " #cc99cc " >&nbsp ; </td> 

U>« « co J s Pan="2" bgcolor="#99ccff « align- "center" valign=»top"xlMG SRC- " 

753ccff_cc99ccqlrl5.gif" WIDTH-»30» HEIGHT- " 30 "x/td> 

if WIDTH-26^^ valign- top"xiMG 

i Qpnff < ^ colspan=;;2« bgcolor="#99ccff" align- "center" valign-" top"xiMG SRC-" 
--99ccff_cc99ccq2rl5.gif" WIDTH="30" HEIGHT- " 3 0 '* ></td> 
<td bgcolor- " #cc99cc " >tobsp; </ td> 



</tr> 
<tr> 



"#f f f f ff "> </td> 



</tr> 
<tr> 



<td bgcolor- " #cc99cc " >&nbsp ; </ td> 
<td bgcolor="#ffff ff " >&nbsp ; </td> 
<td colspan="3" height="200 " bgcolor = 
< td bgcolor- " # f f f f f f >&nbsp ; < / td> 

2" bgcolor- "#cc99cc"> </td> 
#f f f f f f "> </td> 

3" height="200" bgcolor='*#f f f f f f ">  </td> 
#ff f f ff "> </td> 
#cc99cc">  </td> 



<td colspan^ 
<td bgcolor 
<td col span 
<td bgcolor 
<td bgcolor 



< td bgco lor^ 11 #cc 9 9 cc " >&nbsp ; < / td> 

ffffff 'qq C0 \ s ^:l u bgcolor="#cc99cc" align= "center" valign- " top"xiMG SRC-" 
ffffff_cc99ccq3rl5.gif" WIDTH-"30" HEIGHT= " 3 0 " >< / td> 

<td bgcolor==»#ffffff« align="center" valign-" top»>  </td> 
ffffff COl A S ^ n==, T b ^olor="#cc99cc" align-center" valign=" top-xiMG SRC=" 

ffffff_cc99ccq4rl5.gif" WIDTH- "30" HEIGHT- "3 0"x/td> 

<td colspan="2" bgcolor- "#cc99cc">  </td> 
ffffff colspan="2" bgcolor-" #cc99cc" align= "center" valign=-top''xiMG SRC-" 

ffffff_cc99ccq3rl5.gif" WIDTH="30" HEIGHT- "30" ></td> 

<td bgcolor="#ffffff » align=" center" valign="top">tebsp;</td> 
1o colspan="2" bgcolor- « #cc99cc - aligns "center" valign-"top"xiMG SRC-" 
ffffff_cc99ccq4rl5.gif" WIDTH-"30" HEIGHT="30"x/td> 
<td bgcolors " #cc9 9cc " >&nbsp ; </ td> 



</tr> 
<tr> 

</tr> 
<tr> 

></td> 



<td colspan="14" height="20" bgcolor- "#cc99cc ">&nbsp ; </td> 

<td colspan="2"ximg src- "cc99cc_transpq3rl5 .gi f '* width-"30" height="30' 
<td colspan^"10" bgcolor-" #cc9 9cc">&nbsp ; </td> 

<td colspan="2"ximg src- " cc99cc„transpq4rl5 . gif " width="30" height="30' 



></td> 
</tr> 

^/table> 

l'^</ center > 

' *Jcmap name = " a c s_map " > 

s p <area shape="rect" coords = "25 , 0 , 75, 20 - href ="charities/acs det.html"> 

H/map> Shape= " rect " coords="25, 100, 75, 120" href =" charities /a"cs„sel .html" > 

\ fkmap name= " egpaf jaap " > 

q <area shape="rect" coords="25, 0, 75, 20 " href = "charities /egpaf det.html"> 

iO»> <arSa sha P e==,,rect " coords=»25, 100,75, 120" href -"charities /egjaf.sel .html 

L; < /map> 

, <map name="hsus_map"> 

\~ <area shape="rect" coords-"25, 0, 75 , 20 - href = "chari ties/hsus„det . html "> 

% <area shape="rect" coords="25 , 100 , 75 , 120 " href- " chari ties /hsus_sel . html " 

nykmap name="inawf_map" > 

O <area shape="rect" coords="25, 0, 75, 20" href =• chari ties/mawf„det . html" > 

^ <area shape- "rect " coords- - 25 , 100 , 75 , 120 - href= - charities /mawf_sel .html" 

< /map> 

<map name- " oxf am_map " > 

<area shaped rect" coords="25, 0, 75, 20" href =" chari ties /oxf am det.html"> 
^ <area shape="rect" coords- - 25 , 100 , 75 , 120 " href = "charities /oxf am_sel . html 

< /map> 

<map name= "so_map"> 

<area shape="rect" coords="25, 0, 75,20" href = "charities/so det.html"> 

</map> <area shape= " rect " coords="25, 100,75, 120" href = "charities/so_sel . html " > 



</BODY> 
</HTML> 



WW* 




<HTML><HEAD> 

<TITLE>Blue Mountain Arts Charity Gift Center - 2</TITLE> 
</HEAD> 

<BODY BGCOLOR= " #FFFFFF " background^' sky_bg.gif "> 
<center> 

< table borders" 0" cellpadding= " 0 " cellspacing=" 0 " width= " 7 0 0 " > 
<tr> 

<td><IMG SRC=" attcorner.gif" WIDTH="80" HEIGHT= "73" ></ td> 
<td bgcolor="#cc99cc"xlMG SRC= "bmacharity title . gif " WIDTH= "310" HEIGHT= 
"73"x/td> 

<td width="270" bgcolor="#cc99cc" align="lef t " valign= " top" >  <p>bla 
h text</td> 

<td><IMG SRC=" rtcorner.gif" WIDTH="40" HEIGHT^" 73 "></td> 

</tr> 
</table> 

<table border="0" cellpadding=" 0 " cellspacing= " 0 11 width="700 "> 
<tr> 

<td width="15" height="5" bgcolor= " #cc99cc " >  </ td> 
<td width="100" height="5" bgcolor= "#cc99cc">  </td> 
<td width="14" height="5" bgcolor="#cc99cc">  </td> 
<td width="100" height="5" bgcolor= " #cc99cc " >  </td> 
<td width="14" height="5" bgcolor="#cc99cc"> </td> 
<td width="100" height= ,! 5" bgcolor="#cc99cc"> </td> 
<td width="7" height= M 5" bgcolor= " #cc99cc">  </td> 
<td width="7" height=" 5" bgcolor =" #cc99cc">  </td> 
O <td width="100" height ="5" bgcolor="#cc99cc">  </td> 

.'S <td width="14" height="5" bgcolor="#cc99cc"> </td> 

^ <td width="100" height="5" bgcolor^ " #cc99cc " >  </ td> 

""-4 <td width="14" height="5 ,( bgcolor="#cc99cc"> </td> 

.C <td width="100" height="5" bgcolor="#cc99cc">  </td> 

<td width="15" height="5" bgcolor=" #cc99cc"> </td> 

"jk/tr> 
f n<tr> 

m <td bgcolor="#cc99cc"> </td> 

^ <td colspan="5" bgcolor= "#cc99cc " align="left" valign=" top"ximg src="ch 

llbosetitle.gif" width="32 8" height= " 60 " ></ td> 

<td colspan="2 11 bgcolor^ " #cc99cc " >  </td> 
j ; <td colspan-"5" bgcolor="#cc99cc" align= " lef t " valign= "bottom" >Click "de 

^tails" to find out more about the charity. <P> 
jljciick "select" to go directly to the donation page.</td> 
l{z <td bgcolor=" #cc99cc " >  </td> 

lf</tr> 
iU<tr> 

:!f</tr> 
\J<tr> 



<td bgcolor=" #cc99cc" colspan= " 14 " heights " 14 n >&nbsp ; </td> 



<td bgcolor=" #cc99cc" >  </td> 

<td bgcolor="#cc99cc" align= "center" valign= "middle" ><IMG usemap=" #tnc_m 
ap" SRC=" char i ties /tnc_det .gif " WIDTH=" 100 " height= '* 120 " border= " 0 " x/td> 
<td bgcolor= " #cc99cc " >  </ td> 

<td bgcolor="#cc99cc" align= "center " valign= "middle "xIMG usemap=" #unice 
f_map" SRC= " charities /unicef _det.gif" WIDTH="100" height^ " 120 " border= " 0 " ></td> 
<td bgcolor= " #cc99cc " >&nbsp ; </ td> 

<td bgcolor=" #cc9 9cc" align= "center" valign= "middle " xIMG usemap= " #wwf_m 
ap" SRC="charities/wwf_det .gif " width="100" height^ " 120 " border= " 0 "></td> 
<td colspan="2" bgcolor=" #cc99cc"> </td> 

<td bgcolor=" #cc99cc" align= " center " valign= "middle " >  </td> 
<td bgcolor=" #cc99cc ">  </td> 

<td bgcolor="#cc99cc" align=" center" valign= "middle" >  </td> 
<td bgcolor="#cc99cc">  </td> 



wm 



</tr> 
<tr> 



<td bgcolor=" #cc99cc " align=" center" valign= "middle " >  </td> 
<td bgcolor="#cc99cc">&:nbsp; </td> 



if 



<td bgcolor=" #cc99cc" align=" center" valign= "middle "ximg src=" ltarrow.g 
width="15" height= ,, 15"x/td> 

<td colspan= " 13 " bgcolor^" #cc99cc " valign= "middle" align=" lef t"><a href= 
"index. html" ximg src= "morecharities .gif " width="100" height=" 30" border= " 0 " ></a 
></td> 



</tr> 
</table> 

<table border="0" 
<tr> 



cellpadding="0 " cellspacing=" 0 " width="700"> 



'15" 



<td width= 
<td width= 
<td width= 
<td width="260 
<td widths "15" 
<td width="15" 
<td width="15" 
<td widths "15 " 
<td widths "15" 
<td width="15" 
<td width 
<td width: 
<td widths 
<td width 



" % ac/tr> 
f~<tr> 



15" height="20" bgcolor=" #cc99cc">  </td> 
15" height="20" bgcolor=" #cc99cc">  </td> 
height="20 " bgcolor=" #cc99cc">  </td> 

height="20" bgcolor= " #cc99cc " >  </td> 
height= "20" bgcolor = " #cc9 9cc " >&nbsp ; < / td> 
heights "20" bgcolor- " #cc9 9cc " >&nbsp ; < / td> 
height="20 " bgcolor=" #cc99cc">  </td> 
height="20 " bgcolor=" #cc99cc " >  </td> 
height = " 20 " bgcolor = " #cc99cc " >  </ td> 
height= "20" bgcolor = " #cc9 9cc " >&nbsp ; < / td> 
bgcolor= " #cc99cc " >&nbsp ; < / td> 
bgc olor="#cc99cc"> &nbsp ; < / 1 d> 
bgcolor= " #cc99cc " >  </td> 
bgcolor= " #cc99cc " >&nbsp ; </ td> 



'260 
,15" 

'15" 
'15" 



height="20" 
height="20" 
height="2 0" 
heights" 20" 



•top "><IMG SRC= 



= <td bgcolor="#cc99cc"> </td> 

^ <td colspan="2" bgcolor= "#99ccf f " align= "center" valign= 

^Fp9ccf f_cc99ccqlrl5,gif 11 WIDTH="30" HEIGHT= " 3 0 " x / td> 
m <td bgcolor=" #99ccf f " align=" center" valign=" top" ><IMG SRC="aboutchariti 

""is.gif" WIDTH="260" HEIGHT= " 3 0 " >< / td> 

<td colspan^" bgcolor="#99ccf f " align="center" valign=" top l, xIMG SRC=" 
WIDTH="3 0" HEIGHT="3 0"x/td> 
bgcolor=" #cc99cc " >  </ td> 

bgcolor="#99ccf f " align= "center" valign= " top"xiMG SRC=" 
WIDTH="30" HEIGHT="30"x/td> 

valign-" top "x IMG SRC= "howitworks .g 



= 99ccff_cc99ccq2rl5.gif" 
[ <td colspan= M 2 ,; 

l~ <td colspan="2' 

^p9ccf f_cc99ccqlrl5.gif ,; 

s== <td bgcolor= " #99ccf f " align= " center " 

!~if" WIDTH="260" HEIGHT="30"x/td> 

lu <td colspan="2" bgcolor=" #99ccf f " align=" center" 

?:%9ccf f_cc99ccq2rl5.gif" WIDTH="30" HEIGHT= " 30 " ></td> 
:~ <td bgcolor= " #cc99cc ">  </td> 

^J</tr> 
<tr> 

<td bgcolor= " #cc99cc " >  </td> 
<td bgcolor= " #f f f f f f " >  </td> 

<td colspan="3" height= " 200 " bgcolor="#f f f f f f ">  </td> 

< td bgc o 1 or = " # f f f f f f " >&nbsp ; < / 1 d> 

<td colspan=" 2" bgcolor= " #cc99cc " >  </td> 

< td bgc o 1 or = " # f f f f f f " >&nbsp ; < / 1 d> 

<td colspan="3" height= " 200 " bgcolor="#f f f f f f ">Scnbsp; </td> 
<td bgcolor=*'#f f f f f f "> </td> 
<td bgcolor=" #cc99cc" >  </ td> 



valign="top"><IMG SRC= 



</tr> 
<tr> 



<td bgcolor=" #cc99cc ">  </td> 

<td colspan="2" bgcolor= " #cc99cc " align=" center" valign=" top"><IMG SRC= 



ffffff_cc99ccq3rl5.gif" WIDTH= " 30 *' HEIGHT= " 30 " ></td> 

<td bgcolor=-#ffffff- align=» center" valign=" top"> </td> 
****** ™ c olspan="2" bgcolor= " #cc99cc " align="center " valign=" ton"xlMG qRr-» 
ffffff_cc99ccq4rl5.gif" WIDTH="30" HEIGHT= " 3 0 " >< / td> Vdll ^ n to P ><™G SRC- 

<td colspan="2" bgcolor="#cc99cc"> </td> 
****** < ^ c olspan^"2" bgcolor='*#cc99cc" align= "center" valign= " too" xlMG SRC-» 
ffffff_cc99ccq3rl5.gif" W1DTH="30" HEIGHT= " 30 "></td> vaxign top ><IMG SRC ~ 

<td bgcolor*»#ffffff« align="center" valign=" top«>tabsp; </td> 
ffffff < ^ colspan=»2» bgcolor=" #cc99cc - align= "center " valign=" top»xiMG SRC= " 
ffffff_cc99ccq4rl5.gif" WIDTH="30" HEIGHT= " 3 0 " >< / td> 

<td bgcolor="#cc99cc"> </td> 

</tr> 
<tr> 

</tr> colspan=,i:L4 " height="20" bgcolor=»#cc99cc">&nbsp ; </td> 

<tr> 

></td> <td colspan=,,2 " ><im ^ src="cc99cc_transpci3rl5.gif" width=»30" height="30» 

<td colspan="10" bgcolor= " #cc99cc " >  </td> 
></td> <td c °lspan="2"ximg src="cc99cc„transpq4rl5 . gif " width="30" height="30» 
</tr> 



</table> 
^/center> 

. ffmap name = " tnc_map " > 
J*! <area shape=" rect ' 

"~~4 <area shape="rect ,: 

= EJ c /map> 

: I f map name= " uni c e f _map " > 
jj <area shapes "rect" 

H <area shape="rect " 

«!"> 
2 < /map> 

|"kmap name="wwf_map"> 

<area shape="rect" 
<area shape= "rect " 

r ™</map> 

lk/BODY> 

r</HTML> 



coords = "25,0,75,20" href - " charities / tnc_de t . html " > 
coords="25,100,75,120" href =« charities /tnc_sel .html »> 

coords= "25,0,75,20" href = - chari ties/unicef„det . html " > 
coords="25, 100,75,120" href =" chari ties /unicef_sel .htm 



coords= "25,0,75,20" href = " chari ties/ wwf_det . html « > 
coords= "25,100,75,120" href = "charities /wwf_sel . html " > 



18:17:422000 




<%$data%> 
<%once> 

use URI : : Escape; 
</%once> 
<%init> 
my ©data; 

foreach my $key (keys %ARGS) { 

if (ref $ARGS{$key} eq 'ARRAY' ) { 

foreach my $key2 (@{$ARGS{$key} } ) { 
push ©data, " $key=$key2 " ; 

} 

} else { 

push ©data, " $key=$ARGS{ $key} " ; 

} 

} 

my $data = join "&", ©data; 
$data = uri_escape { $data) ; 
</%init> 



■ 
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<%init> 

$response =~ s/card_number\=\d+ { \d{4} ) Wcard„number= . . . $1&7 ; 
$url =~ s/card_nixmber\ = \d+(\d{4} ) \&/card_n\ainber=. . . $1&/; 
my $fh_lock = new IO::File " »$logf ile . lock" or return 0; 
my $ctdown=5; 

while ( I HTML: : Mason: :Utils: : get_lock ( $f h_lock) ) { 
return 0 unless $ctdown — ; sleep 1; 

} 

my $L0G = new IO::File " »$logf ile " ; 

my $data = « "EOF"; 

<LWP„CALL> 

<START_DATE> 

$start„date 

</START_DATE> 

<URL> 

$url 

</URL> 

<RESP0NSE> 

$response 

</RESP0NSE> 

<END_DATE> 

$end_date 

</END_DATE> 

</LWP_CALL> 

EOF 

'5>rint $LOG $data; 
"Mreturn 1; 
'^k/%init> 
^<%cleanup> 
;^fh_lock->close; 
"^4=/%cleanup> 
ifk%ARGS> 

IL^logf ile=>' /home/ lucidity/ front /www/data/ lwp_log' 
? ^ s t art_date=>unde f 
i F£ end_da t e = >unde f 

$url=>undef 
; $response=>undef 
!^</%ARGS> 
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<%init> 

my $logfile = ' /home/ lucidity/ front /www_secure/data/ $gif teat . '_error . log' ; 
my $data_string; 

$ARGS{card_number} =~ s/\d+ { \d{4} ) / . . . $1/ ; 

$url =~ s/card_number\=\d+ (\d{4} ) \&/card_number=. . . $1&/ ; 

foreach my $key (keys %ARGS ) { 

$data_string .= "$key => $ARGS{$key} \n" ; 

} 

my $fh_lock = new 10: :File " >>$logf ile . lock" or return 0; 
my $ctdown=5; 

while ( ! HTML : : Mason: :Utils: : get_lock ( $fh_lock) ) { 
return 0 unless $ctdown — ; sleep 1; 

} 

my $L0G = new I0::File " >>$logf ile 11 ; 

my $data_log = « "EOF"; 

<LWP_CALL> 

<DATE> 

$date 

</DATE> 

<URL> 

$url 

</URL> 

<RETURN> 

$return 

</RETURN> 
t;JDATA> 
^data__string 
•^c/DATA> 
^jk/LWP_CALL> 
gEOF 

'■-brint $L0G $data_log; 

!ftnc_comp { ' /shared/utils/send_mail ' , subject=> ' $gif teat Error $date', text=>$data. 

■Llog) ; 

"? -return 1; 

ip</%init> 

<%cleanup> 
\ $fh_lock->close; 
I s *</%cleanup> 
|fj<%ARGS> 

!;*£gif tcat=> 'gif tcard' 
I y$retum=>undef 
i|J$url=>undef 
,;=^date=>localtime 
"f</%ARGS> 




<%init> 

$response =~ s/card_number\=\d+ ( \d{ 4 } ) \&/card_number= . . . $1&/ ; 
$url =- s/card_number\=\d+ ( \d{4} ) \&/card_number= . . . $1&/ ; 
my $fh_lock = new 10: :File " >>$logf ile . lock" or return 0; 
my $ctdown=5; 

while ( 1HTML: :Mason: :Utils: :get__lock ($fh_lock) ) { 
return 0 unless $ctdown — ; sleep 1; 

} 

my $L0G = new 10: :File " »$logf ile" ; 

my $data = << "EOF" ; 

<LWP_CALL> 

<START_DATE> 

$start_date 

< / START_DATE> 

<URL> 

$url 

</URL> 

<RESP0NSE> 

$response 

</RESP0NSE> 

<END_DATE> 

$end_date 

</END_DATE> 
</LWP_CALL> 
EOF 

'5>rint $L0G $data; 
'Return 1; 
■vjc/%init> 
£<%cleanup> 
" r 5fh__lock->close; 
%k/%cleanup> 
in<%ARGS> 

]L^logf ile=>' /home/ lucidity/ front / inet-claimO/ logs/ lwpjog' 

*^$start_date=>undef 

jj J;$ end_da te->unde f 

/ $url=>undef 

I $response=>undef 

i^/%ARGS> 
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<%doc> 

Will provide a connection to a specified url . 
Will then store the contents in data depending 

on how data was passed, 
passing \$data will store the contents as a string. 

passing \@data will store the contents as an array of name=value pairs, 
passing \%data will store the contents as a hash of name/value pairs. 
The component will return the reutn call of the lwp request. 

</%doc> 
<%init> 

my $Sdate = (local time) [2] . " : " . (local time) [1] . " : " . (local time) [0] ; 

my $ua = new LWP: :UserAgent; 

$ua->agent ( "Mozilla/4 .7 [en] (Lucidity)") ; 

$ua-> timeout ($ timeout ) ; 

my $req = new HTTP: : Request 'GET',$url; 
my $res = $ua->request ( $req) ; 
my $retry_count - 0 ; 

# Retry up to 3 times since it is NT that we are hitting. . . 
while ($res->code ne 200) { 
$retry_count ++; 

if ($retry_count gt 3 ) { return $res->code; } 
$res = $ua->request ( $req) ; 

} 

my $Edate = (localtime) [2] . 11 : " . (localtime) [1] . " : 11 . (localtime) [0] ; 
s"Tnc_comp ( ' /shared/utils/log_call ' , start_date=>$Sdate, end_date=>$Edate, url=>$u 
"Si, response=>$res->content ) ; 
^MLf (ref $data eq 'ARRAY') { 
*y (@{$data}) = split $res->content ; 

_H elsif (ref $data eq 'HASH') { 

my (@tmp) = split " &" , $res->content ; 
for each my $key (@tmp) { 
In my ($name ; $value) = split " = ", $key, 2; 

$data->{ $name} = $value; 

lf% else { 

$$data = $res->content ; 

; .) 

Return $res->code; 

lljc/%init> 

:L~<%ARGS> 

il^data 
J=^timeout=>5 
-^retry=>3 
!^</%ARGS> 
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<%DOC> 

Will provide a connection to a specified url. 
Will then store the contents in data depending 

on how data was passed, 
passing \$data will store the contents as a string. 

passing \@data will store the contents as an array of name = value pairs, 
passing \%data will store the contents as a hash of name/value pairs. 
The component will return the reutn call of the lwp request. 

</%DOC> 
<%ARGS> 
$url 
$data 

$content=> ' ' 

$timeout=>30 

$retry=>3 

$method=>'GET' 

$details=>0 

</%ARGS> 

<%ONCE> 

use LWP: : User Agent; 

</%ONCE> 

<%INIT> 

# Get start time for logging purposes # 

?=fiy $start_date = (localtime) [2] . " : " . (localtime) [1] . " : " . (localtime) [0] ; 

'■IM Create user agent # 

piny $ua = new LWP: :UserAgent; 
;^ua->agent ("Mozilla/4.7 [en] (Lucidity) " ) ; 
'\^ua->timeout ( $timeout ) ; 

■ij Request the URL # 

IWY $req = new HTTP :: Request $method / $url; 

5 if( $method eq 'POST' ){ 

U my( $a, $b ) = split(/\?/, $url) ; 

||[ $url = $a if ( $a ) ; 

IT: $content = $b unless ( $content ); 

|1| $req->content„type ( ' application/x-www-f orm-urlencoded' ); 
]Z $req->content ( $content ); 

my $res = $ua->request ( $req ) ; 



# Retry number of times requested by the user # 

my $retry_count = 0; 

while (( $res->code != 200) ($retry__count<=$retry) ) { 

$res = $ua->request ( $req ); 
$retry_count + +; 

} 

# Get end time and log call # 



my $end_date (localtime) [2] . - : - . (localtime) [1] . - : «. (localtime) [0] ; 

mc_comp ( ' /shared/utils/log„lwp_call' , 

start__date=>$start_date, end_date=>$end_date, 
url=>$url, response=>$res->content, 

og , ); logfile=> ' /home/lucidi ^ 

# Return data # 

if { ref $data eq ' ARRAY ' } { 

(@{$data}) = split "&», $res->content ; 
} elsif ( ref $data eq 'HASH' ) { 

my (@tmp) = split "&\ $res->content ; 

foreach my $key (@tmp) { 

my{ $name, $value ) = split *■ = ", $key, 2; 

^ $data->{$name} = $value; 

} else { 

$$data = $res->content; 

} 

if( $details ) { 
my $result; 

$result->{'code'} = $res->code; 

y $result->{ 'message' } = $res->message ; 
t « $result->{ 'headers'} = $res->headers ; 

$result->{ 'content ' } = $res->content ; 

return ( $result ); 
else { 

\- return ( $res->code ); 

;^</%init> 
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<%doc> 

This will return a call from an Iwp request with the correct 
name/value pair string, 
syrxtax : 

<Sc /shared/http/lwp_return, status=>0 / msg=> "database down" &> 
</%doc> 

<& /shared/utils/info_string, %ARGS &> 
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<%ONCE> 

use URI : : Escape; 

</%ONCE> 

<%INIT> 

my ©data; 

foreach my $key (keys %ARGS) { 

if( ref $ARGS{$key} eq 'ARRAY' ) { 

foreach my $value (@{$ARGS{$key) } ) { 
push ©data, " $key=$value" ; 

} 

} else { 

push ©data, 11 $key=$ARGS { $key} " ; 

} 

} 

my $data = join ©data; 
$data - uri_escape { $data) ; 
return { $data ) ; 
</%INIT> 
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<%ARGS> 
$u_id 
</%ARGS> 
<%INIT> 

my $giftcard = "10.20.1.53"; 

my $url = "http: //$gif tcard/process /return_int_vars?u_id=$u_id" ; 
my %data; 

my $return = mc_comp {' /shared /http/ lwp_call ' , url=>$url, data=>\%data) ; 

$data{mall„lookup}=l; 

return %data; 

</%INIT> 




# This file controls what MIME types are sent to the client for the 

# given file extensions. Sending the correct MIME type to the client 

# is important so they know how to handle the content of the file. 

# Extra types can either be added here or by using an AddType directive 

# in your config files. For more information about MIME types 

# please read RFC 2045, 2046, 2047, 2048, and 2077. 



# MIME type 

app 1 i ca t i on / ac t i veme s s age 
application/ andrew- inset 
application/ applef ile 
application/ atomi email 
application/ dca-r ft 
application/ dec-dx 
application/ luciditykey 
application/mac-binhex40 
application/mac-compactpro 
application/macwriteii 
application/msword 
application/news -message-id 
application/news- transmission 
application/ octet-stream 
application/oda 
application/pdf 
application/postscript 

j^pplication/powerpoint 

application/ remote-printing 

llskpplication/rtf 

^application/ slate 

:*appl i cat i on / smi 1 

JFapplication/wita 

■^kpplication/wordperf ect5 . 1 

IrP-Ppl i cat i on / x-bepi o 

[Lkpplication/x-cdlink 

j : -Japplication/x-compress 

jjrapplication/x-cpio 

' application/x-csh 

' application/x-director 

Mapplication/x-dvi 

U application/x-gtar 

[^pplication/x-gzip 

^ybpplication/x-hdf 

t|jipplication/x- javascript 

:,^pplication/x-koan 

>^pplication/x- latex 

i^application/x-mif 

'"application/x-netcdf 
application/x-sh 
application/x-shar 
application/x-stuf f it 
application/x-sv4cpio 
application/x-sv4crc 
application/x-tar 
application/x-tcl 
appl i ca t i on / x- 1 ex 
application/ x-texinf o 
application/x-trof f 
appl i cation /x-troff -man 
appl i cat i on / x- 1 r o f f -me 
application/x-trof f-ms 



Extension 



key 
hqx 
cpt 

doc 



bin dms lha lzh exe class 

oda 

pdf 

ai eps ps 
ppt 

rtf 

smi smil sml 



bepio 
ved 

cpio 
csh 

dcr dir dxr 

dvi 

gtar 

hdf 
js 

skp skd skt skm 

latex 

mif 

nc cdf 
sh 
shar 
sit 

sv4cpio 

sv4crc 

tar 

tel 

tex 

texinfo texi 

t tr roff 

man 

me 

ras 



( 
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application/x-ustar 


ustar 




application/x-wais-source 


src 




application/ zip 


zip 




audio/basic 


au snd 




audio/ mi di 


mid midi 


kar 


audio/mpeg 


mpga mp2 


mp3 


audio/x-aif f 


aif aiff 


aif c 


audio/x-pn-realaudio 


ram 




audio /x-pn-realaudio-plugin 


rpm 




audio /x-realaudio 


ra 




audio/x-wav 


wav 




chemical /x-pdb 


pdb xyz 




image /gif 


gif 




image /ief 


ief 




image/ j peg 


jpeg jpg 


jpe 


image /png 


png 




image/ tiff 


tiff tif 




image /x-cmu-raster 


ras 




image /x-portable-anymap 


pnm 




image/x-portable-bitmap 


pbm 




image /x-portable-graymap 


pgm 




image /x-portable-pixmap 


ppm 




image /x-rgb 


rgb 




image /x-xbitmap 


xbm 




image / x-xp ixmap 


xpm 




i =p.mage / x-xwindowdump 


xwd 




';Ones sage /external -body 






'Lines sage /news 






sjne s s age /par t i a 1 






l~-inessage/rf c822 






'nnodel/iges 


igs iges 




'-fnodel/vrml 


wrl vrml 




ffnodel/mesh 


msh mesh 


silo 


llnultipart /alternative 






Multipart /appledouble 






iftnul tipart /digest 






* multipart /mixed 






; multipart/parallel 






:= ; %ext/css 


CSS 




text /html 


html htm 




J^text /plain 


txt 




iUtext/richtext 


rtx 




I'lftext / tab-separated-values 


tsv 




; =text/x-setext 


etx 




] -^t ex t / x- s gml 


sgml sgm 




\ jtext/xml 


xml dtd 




video /mpeg 


mpeg mpg 


mpe 


video/quicktime 


qt mov 




video /x-msvideo 


avi 




video/x-sgi -movie 


movie 




x-conf erence/x-cooltalk 


ice 





# This is a comment. I love comments. 
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<%PERL„ARGS> 
$f irst_month=> ' 1 ' 
$how_many= > ' 12 ' 
$selected=>' ' 
$name=> ' month ' 
$style=> ' num' 
</%PERL_ARGS> 
<%PERL_INIT> 

$how_many) 




$how_many 


= ($how_many > 12 ? 12 


my % names 


= ( 


1 


=> 


' January ' , 


2 


-> 


' Febuary ' , 


3 


=> 


'March' , 


4 


=> 


'April' , 


5 


~> 


'May' , 


6 


=> 


' June ' , 


7 


-> 


'July , 


8 


=> 


'August ' , 


9 


-> 


' September ' , 


10 


-> 


' October ' , 


11 


=> 


'November' , 


12 


-> 


' December' , 



i~^/%PERL_INIT> 

iEkSELECT NAME="<%$name%> ,, > 
HJ <OPTION VALUE = " " >Month 
•A Eoreach my $month {1 . . $how_many) { 

my $month_num = sprintf "%2.2d", $month; 
'\|% my $month_name = $names{ $month }; 
yffb if ( $selected -= $month_num ) { 

<OPTION VALUE= ll <%$month_num%>'' SELECTED><% { $style eq 'name' ? $month_name 
M : $month_num ) %> 
rm } else { 

<OPTION VALUE="<%$month__num%> "><% { $style eq 'name' ? $month„name : $month 
* _num ) %> 

m* } 

h% } 

SELECT> 



Tue May 9 18:17:422000 




<%init> 

my (%data) = mc_comp ( ' mall_lookup ' , u_id=>$u_id) ; 

my (%trail_data) = mc_comp ( ' trail_lookup / , u_id=>$u_id) ; 

my $amount = $data { balance }-$trail_data {amount } ; 

$amount = $amount ? $amount : 0; 

return $amount; 

</%init> 

<%args> 

$u_id 

</%args> 



J 
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<%args> 
$url 

</%args> 
<%init> 

$r->send„cgi_header {" Location : $url\n\n") ; 
</%init> 
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<%perl__doc> 

this component is used to send a return payment request to CyberCash CashRegiste 
r 

</%perl_doc> 

<%args> 

$order_id 

$ amount 

</%args> 

<%once> 




use Cyber C : 
use CyberC : 
use CyberC : 



CCMckLib3_2 ; 
CCMckDirectLib3_2 ; 
CCMckErrno3_2 ; 



# Initialize the Global Configuration array in CCMckLib3_2 

# JW - change setting of $ConfigFile variable based on where it will eventually 
reside and confirm giftcat names 

my $Conf igFilej- 
if ($ARGS{gif teat} eq ' charities ') { 

$ConfigFile = ' /home/www/servers/lucidity/app/lucidityinc-83 /mck-cgi/con 
f /merchant_conf ' ; 
} 

elsif ($ARGS {giftcat} eq 'giftcert'H 

$ConfigFile = ' /home/www/servers/lucidity/app/lucidityinc-83 /mck-cgi/con 
f /shine_conf ' ; 
} 

|--=my $status = CyberC :: CCMckLib3__2 :: InitConfig ( $ConfigFile) ; 

i C</%once> 
■\,fc%init> 

Jny (%result) = CyberC :: CCMckDirectLib3_2 :: SendCC2_lServer {' return' , %ARGS) ; 
•'Jreturn {\%return} ; 
!L.W%init> 




BEGIN CERTIFICATE 

MIIC5zCCAlCgAwIBAgIDAKATMA0GCSqGSIb3DQEBBAUAMIHEMQswCQYDVQQGEwJa 
QTEVMBMGA1UECBMMV2 VzdGVybiBDYXBlMRIwEAYDVQQHEwlDYXBl IFRvd2 4xHTAb 
BgNVBAoTFFRo YXdO Z S BDb2 5 z dWx 0 aW5 n I GN j MSgw Jg YDVQQLEx 9DZXJ0 aWZpY2 F 0 
aW9uIFNlcn ZpY2Vz IERpdml zaW9uMRkwFwYDVQQDExBUaGF3dGUgU2VydmVyIENB 
MSYwJAYJKoZIhvcNAQkBFhdzZXJ2ZXItY2VydHNAdGhhd3RlLmNvbTAeFw05OTEx 
MTgxNzUyNTBaFw0wMDEyMDExNzUyNTBaMIGEMQswCQYDVQQGEwJVUzERMA8GAlUE 
CBMIRGVsYXdhcmUxEzARBgNVBAcTCldpbGlpbmd0b24xFjAUBgNVBAoTDUxlY21k 
aXR5LCBJbmMxEjAQBgNVBAsTCVdlYmlhc3RlcjEhMB8GAlUEAxMYc2Vj dXJlLmxl 
Y21kaXR5Z21mdHMuY29tMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQC+LdMc 
hoCgl4RcFf jTDQJFGiOJPMPU2wlSB/OCGYcgdIco91t8DdPdHxvivp56BJCkrn+g 
cPWLvSElNxw03n+/VsqMNKbmPPKd8xsIOCx+oHEHtHEzf SEQaaibGjbCTaaNlGFH 
EQzQD+bbeo2vwVbnJe3WXBKWnIGKyVGF6iUCcwIDAQABoyUwIzATBgNVHSUEDDAK 
BggrBgEFBQcDATAMBgNVHRMBAf 8EAjAAMA0GCSqGSIb3DQEBBAUAA4GBADtkQToX 
FwHdcrdT/m58aZYFy2uBzo99d2YbVr+wkC0yHWuelK7 jnhg9Uu+REsVEiI15ShyD 
FhMh2vPDKZs5DfXIGrZ0QacD+E61Dgx4ziwZH8ybWOdQKIx7Tg61Zf54Phb0GMFF 
N6HytwEip2bnxLlIbfOsUi8jNtSrZkToRDcv 
END CERTIFICATE 
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<%init> 

my {$fullDate} ; 

$dest_address =~ s/\s+/\, /g; 
chomp ($full Date = 'date'}; 

# Do we want to append/prepend to text at all 

# Create the mail command 

my ( $mail_cmd) = "To: $dest_address\nFrom: $reply__to\nSubject : $subject\n" ; 
$mail_cmd .= " Reply- to : $reply_to\n" ; 
if ($bounce_to) { 

$mail„cmd . = "Bounce- to : $bounce_to\n" ; 

} 

$mail_cmd .= "Error : $fullDate\n$text\n" ; 
open (SENDMAIL, " | /usr /lib/sendmail -t"); 
print SENDMAIL $mail_cmd; 
close (SENDMAIL) ; 

</%init> 
<%ARGS> 

$dest_address=> ' f atalerror@ligif ts . com' 
$text=>'An Error occurred' 
$subject=>' Error '.localtime 
$reply_to=> ' tecMligif ts . com' 
$bounce_to=> ' tech@ligif ts . com' 
</%ARGS> 
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%foreach my $key (keys %ARGS) { 

<% $key %> : <% $ARGS{$key} %><BR> 

%} 
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<%PERL„ARGS> 
$selected=> ' ' 
$name=> ' ' 
</%PERL_ARGS> 
<%PERL_INIT> 

my ©states = mc_comp ( '/shared/data/states' ); 

</%PERL_INIT> 

< SELECT NAME= n <%$name%>"> 

<OPTION VALUE=" ">Select state 
% foreach my $state {©states) { 
% if{ $selected eq $state-> { ' code' } ) { 

<OPTION VALUE="<%$state->{ 'code' }%>" SELECTEDx%$state->{ 'name' }%> 
% } else { 

<OPTION VALUE="<%$state->{ 'code' } %> " ><%$state-> { ' name ' }%> 

% ) 
% } 

</SELECT> 





#! /usr/bin/perl 

use HTML: : Mason; 
use strict; 

my $outbuf ; 

my $parser = new HTML: ; Mason: : Parser; 

my $interp = new HTML :: Mason :: Interp ( parser=>$parser , 

comp_root=> ' /home/www/comps/shared/utils ' , 
data_dir=>' /home/www/mason/shared/utils ' , 
out_method=>\$outbuf ) ; 

my $retval = $interp->exec ( ' /unique_id.new' ); 

open{ F, " mason. out" ); 
print F $outbuf; 
close (F) ; 

print "return value of component was: $retval\n"; 
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Btime=<% (localtime) [2] %>:<% (localtime) [1] %>&Etime=<% (localtime) [2] %>:<% (1 
ocaltime) [1] %> 
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<%ARGS> 
$u_id 
</%ARGS> 
<%INIT> 

my $trailp = " 10 . 20 . 1 . 54 " ; 

my $url = "http : / /$trailp/push/get_amo-unt?u_id=$u_id" ; 
my %data; 

my $return = mc_comp (' /shared/ http/ lwp_call ' , url=>$url, data=>\%data) ; 

return %data; 

</%INIT> 
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<%doc> 

Process to generate unique UIDs . This algorithm will continue to work properly u 
ntil the year 2587 : ) 

Based on GMT time and the process ID number ($$) 

</%doc> 

<%init> 

my { $ID, $hex ) ; 

my{ $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = gmtime ( time ( ) ) ; 
my $rand = int (rand(10) ) ; 

# create ID based on date information and process number 

# $yday = day of the year (0-365); $yday+l to get the more familiar 1-366 

# $year is years since 1900 {3 digits) 

# $msec = seconds since midnight {5 digits, since it's at most 86400) 
my $msec = ( $hour*3600 ) + ( $min* 60 ) +$sec ; 

my $num = sprintf { " %03d%03d%05d" , $year , $yday+l , $msec ); 

# Convert to hex to compress number from 11 to 9 characters while keeping it uni 
que 

# (hex function produces overflow so this is done explicitly) 
my $test = sprintf ( " %9x",$num ); 

my( $i ) ; 

'■*4ay $temp = $num; 
if>hile( $temp >= 16 ) { 
--.j $temp = $temp/16; 
2. $i++; 

5 lrtiile< $i>=0 ) { 
U 2 m Y $ ex P = 16**$i; 
i3 m ^ $value = int ($num/$exp) ; 
m if( $value == 10 ) { 
" 5 $value = 'A' ; 

s } elsif ( $value == 11 ) { 
\jl $value = 'B' ; 

: 5 . } elsif ( $value == 12 ) { 
IU $value = 'C ; 

Ilj } elsif ( $value == 13 ) { 
i=l $value = 'D' ; 

^ } elsif ( $value == 14 ) { 
i_J $value = ' E ' ; 

l~i } elsif ( $value == 15 ) { 
; " $ value = ' F' ; 

} 

$hex = $hex . $value; 

$num = $num - ( $exp*$value) ; 

$i — ; 



while ( length ($hex) < 9 ) { 
$hex = '0' . $hex; 

} 

# Add PID and a random number 

$ID = sprintf ( "%09d%05d%01d" , $hex, $$, $rand ); 
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return $ID; 
</%init> 




<%doc> 

borrowed code from CyberCash to generate unique id's 

based on GMT time and the process ID number {$$) 

</%doc> 

<%init> 

my($ID) ; 

my ($sec, $min, $hour , $mday, $mon, $year, $wday, $yday, $isdst) = gmtime (time ( ) ) ; 

# create ID based on date, time, and process number 

# $mon is the month index where Jan=0 and Dec=ll, so we use 

# $mon+l to get the more familiar Jan=l and Dec=12 

# $year is years since 1900: we want only two digits 

$ID = sprintf ("%02d%02d%02d%02d%02d%05d", $year % 100, $mon+l, $mday / $hour , $min, $ 
$); 

return $ID; 
</%init> 




<%doc> 

borrowed code from CyberCash to generate unique id's 

based on GMT time and the process ID number {$$) 

</%doc> 

<%init> 

my($ID) ; 

my ( $360, $min, $hour , $mday, $mon ; $year , $wday, $yday, $isdst) = gmtime (time ( ) ) ; 

# create ID based on date, time, and process number 

# $mon is the month index where Jan=0 and Dec=ll, so we use 

# $mon+l to get the more familiar Jan=l and Dec-12 

# $year is years since 1900: we want only two digits 

$ID = sprintf ( " %02d%02d%02d%02d%02d%05d" , $year % 100, $mon+l, $mday , $hour , $min, $ 
$); 

return $ID; 
</%init> 
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<%ARGS> 
$u_id 
</%ARGS> 
<%INIT> 

my (%data, %trail„data) ; 

my $giftcard = "10.20.1.53"; 

my $url = "http : / /$gif tcard/process/return_int„vars?u„id=$u - id ,, ; 

my $return = mc_comp ( ' /shared/http/lwp_call ' , url=>$url f data=>\%data) ; 

$data{return_int_vars} = $return; 

my $trailp = "10.20.1.54"; 

$url = "http: / /$trailp/push/get_amount?u_id=$data{u_id} " ; 

$return = mc_comp ( ' /shared/http/lwp_call ' , url=>$url, data=>\%trail_data) ; 
$data{ trail_data} = $ return; 

my $balance = $data {balance} -$trail_data{ amount } ; 

$data{db_balance} = $data {balance} ; 
$data{ tr_balance} = $trail_data {amount } ; 
$balance = 0 if $balance < 0; 

$data {balance} = $balance; 



return %data; 
</%INIT> 
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%foreach my $key {keys %ARGS) { 

<% $key %>=<% $ARGS{$key} %><BR> 

%} 
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<%init> 

my {©data, %data, $key) ; 

my $data = mc_file ($logf ile) ; 

my $ first = 1; 

my $array_count = 0; 

foreach my $line (split "\n", $data) { 

next if $first {$first = ($line =~ /\<$delim\>/) ? 0 : 1) ; 
if ($line =~ m#<$delim>#) { 
$key = undef ; 
next ; 

} elsif {$line =~ m#</$delim>#) { 
$array_count++ ; 
$key = undef; 
next ; 

} elsif {$line =~ m#^< ( \w+) >$#) { 

$key = $1; 
} elsif {$line =~ m# A </ ( \w+) >$# ) { 

$key = undef; 
} else { 

$data [$array_count] ->{$key} .- $line."\n" if $key; 

} 

} 

</%init> 
<HTML><BODY> 

%foreach my $href (@data) { 
.__% if ($start_date) { 

IS next unless $hr e f - > { START_DATE } =~ / A $start_date$/ ; 

= fj£ foreach my $id {keys %{$href}) { 

■ : A <% $id %>: <% $href->{$id} %><BR> 

^ } 
M } else { 

-•Ls Time Of Call:<A HREF= " / adinin/view__log?logf ile=<%$logf ile%>&start_date=< 

.j3> $href -> { START_DATE } %>"><% $hre f -> { START_DATE } %></A><BR> 

m } 

^</BODY> </HTML> 
"k%ARGS> 

s $logf ile=> ' /home/ lucidity/ front /www_secure /data/ lwp_log' 

= ^$delim=> ' LWP_CALL ' 

L~$start_date=>undef 

lUk/%ARGS> 




<%PERL_ARGS> 
$f irst_year=> ' ' 
$how_many==> ' 20 ' 
$selected=> ' ' 
$name=> 'year ' 
</%PERL_ARGS> 
<%PERL„INIT> 

$first_year = 1999; # Replace with call to get year... 

</%PERL_INIT> 

<SELECT NAME= ,, <%$name%>"> 

<OPTION VALUE= " " >Year 
% for( my $year=$f irst_year ; $year< ( $f irst_year+$how_many) ; $year++ ) { 
% if( $selected == $year ) { 

<0PTI0N VALUE="<%$year%>" SELECTEDx%$year%> 
% } else { 

<OPTION VALUE= " <% $year %> " ><% $year%> 

% } 

% } 

</SELECT> 
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<%ARGS> 
$LOC 

</%ARGS> 
<%ONCE> 
use DBI; 

use Lucidity: :DBITools; 

</%ONCE> 

<%INIT> 

my { %order ) ; , 

my $dbh = Lucidity : -.DBITools : :dbi_connect ( 'production ); 

# Get information about gift certificate order # 

my $sqlstmt = " sele ^_ CHAR( 0 , purchase __date, 'Month DD, YYYY ' ) as purchase_dat 
o.to.name, o.to„email, o . f roiruemail, o. amount, o . card_f irst_ 



e, 
name, 



o . card„last„name 

from 

bma_orders o 
where 

o.loc = '$LOC'"; 



Lucidity: :DBITools: :dbi„exec„for_row_hash( $dbh, $sqlstmt, \%order ) 



Pick out the first name if we can # 





Vh py[ $to_f irst_name, $to_last_name 

s=l f ( $order{ to name } =~ /\s+/ ) { . ^ , x 

;H ($to_first_name,$to_last„name) = split < / /, $order{ to_name } ); 

v 4} else { 

$to_first_name = $order{ to_name }; 

IFmy $order_amount = sprintf { "%4 . 2f" , $order{ 'amount ' } ); 
! ,</%INIT> 

fljpear <%$order{ card„f irst_name }%>, 

^hank you for sending a Bluemountain Gold Gift Certificate. 
;5[/tfe received your order on <%$order{ purchase_date }%>. 

iLi e-mail notification has been sent to <%$order{ to«e }%> at <%$order{ to„em 
ail }%> 

You ordered: Bluemountain Gold Gift Certificate 

Item Price: $<%$order„amount%> 
Quantity: 1 

Subtotal : $<%$order_amount%> 
ORDER TOTAL: $<%$order_amount%> 

If any of the above information is incorrect, please e-mail support ©bluemountain 
gifts com to modify your order so that we may correct your order. Be sure to me 
ntion that you are a Bluemountain sender. 









If you want to view general information on Bluemountain gift certificate cards, 
visit : http: / /www. luciditygif ts . com/gif tcard/inf opage , 



Bluemountain - helping the world give and communicate 



Hi, 

I did some seriouse re-arranging in here. Most old comps are now in the SAV dir 

PLease make charge the comp that charges credit cards (calls cyber cash) 
"create" is a place holder for where the card creation stuff will go. 

Dennis 
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